MODULE DUMP
 
! Create and write ("dump") to various output files
 
USE PRECISION_PARAMETERS
USE COMP_FUNCTIONS
USE MESH_VARIABLES
USE GLOBAL_CONSTANTS
USE TRAN
USE ISODEFS
USE COMPRESSDEFS
USE MESH_POINTERS
USE DEVICE_VARIABLES
USE CONTROL_VARIABLES
USE TYPES

IMPLICIT NONE
PRIVATE

CHARACTER(50), DIMENSION(:), ALLOCATABLE :: FNDUMP
INTEGER, PARAMETER :: ONE_INTEGER=1,ZERO_INTEGER=0
INTEGER, DIMENSION(:), ALLOCATABLE :: LUDUMP
REAL(EB), POINTER, DIMENSION(:,:,:) :: WFX,WFY,WFZ
INTEGER :: N_DEVC_FILES
CHARACTER(50) :: TCFORM
LOGICAL :: EX,DRY
CHARACTER(255), PARAMETER :: dumpid='$Id: dump.f90 6368 2010-06-22 13:40:57Z s.kilian@hhpberlin.de $'
CHARACTER(255), PARAMETER :: dumprev='$Revision: 6368 $'
CHARACTER(255), PARAMETER :: dumpdate='$Date: 2010-06-22 14:40:57 +0100 (Tue, 22 Jun 2010) $'

TYPE (MESH_TYPE), POINTER :: M=>NULL()
TYPE (DROPLET_TYPE), POINTER :: DR=>NULL()
TYPE (OBSTRUCTION_TYPE), POINTER :: OB=>NULL()
TYPE (VENTS_TYPE), POINTER :: VT=>NULL()
TYPE (PARTICLE_CLASS_TYPE), POINTER :: PC=>NULL()
TYPE (SPECIES_TYPE), POINTER :: SS=>NULL()
TYPE (REACTION_TYPE), POINTER :: RN=>NULL()
TYPE (SURFACE_TYPE),POINTER :: SF=>NULL()
TYPE (MATERIAL_TYPE),POINTER :: ML=>NULL()
TYPE (PROPERTY_TYPE), POINTER :: PY=>NULL()
TYPE (DEVICE_TYPE), POINTER :: DV=>NULL(), DV2=>NULL()
TYPE (SLICE_TYPE), POINTER :: SL=>NULL()
TYPE (WALL_TYPE), POINTER :: WC=>NULL()
TYPE (BOUNDARY_FILE_TYPE), POINTER :: BF=>NULL()
TYPE (ISOSURFACE_FILE_TYPE), POINTER :: IS=>NULL()
TYPE (INITIALIZATION_TYPE), POINTER :: IN=>NULL()

PUBLIC ASSIGN_FILE_NAMES,INITIALIZE_GLOBAL_DUMPS,INITIALIZE_MESH_DUMPS,WRITE_STATUS_FILES, &
       TIMINGS,FLUSH_GLOBAL_BUFFERS,FLUSH_EVACUATION_BUFFERS,FLUSH_LOCAL_BUFFERS,READ_RESTART,WRITE_DIAGNOSTICS, &
       WRITE_SMOKEVIEW_FILE,DUMP_MESH_OUTPUTS,UPDATE_GLOBAL_OUTPUTS,DUMP_DEVICES,DUMP_HRR,DUMP_MASS, DUMP_CONTROLS,&
       GET_REV_dump, &
       DUMP_VEG
       

CONTAINS

 
SUBROUTINE UPDATE_GLOBAL_OUTPUTS(T,NM)

USE COMP_FUNCTIONS, ONLY : SECOND
REAL(EB) :: TNOW
INTEGER, INTENT(IN) :: NM
REAL(EB),INTENT(IN) :: T

TNOW = SECOND()

CALL UPDATE_HRR(NM)
CALL UPDATE_MASS(NM)
CALL UPDATE_DEVICES(T,NM)

TUSED(7,NM) = TUSED(7,NM) + SECOND() - TNOW
END SUBROUTINE UPDATE_GLOBAL_OUTPUTS


SUBROUTINE DUMP_MESH_OUTPUTS(T,NM)
USE COMP_FUNCTIONS, ONLY : SECOND
USE TURBULENCE, ONLY: DUMP_RAW_DATA
REAL(EB) :: TNOW
REAL(EB), INTENT(IN) :: T
INTEGER, INTENT(IN) :: NM

TNOW = SECOND()

EVACUATION_DUMP: IF (ANY(EVACUATION_GRID) .AND. EVACUATION_ONLY(NM)) THEN
! Dump the EVAC flowfieds for all EVAC meshes
   CALL DUMP_SLCF(T-EVAC_DT_FLOWFIELD*EVAC_TIME_ITERATIONS,NM,0)
ELSE
   IF (T>=PART_CLOCK(NM).AND.DROPLET_FILE) THEN
      IF (SYNCHRONIZE) THEN
         CALL DUMP_PART(T,NM)
      ELSE
         CALL DUMP_PART(PART_CLOCK(NM),NM)
      ENDIF      
      DO
         PART_CLOCK(NM) = PART_CLOCK(NM) + DT_PART
         IF (PART_CLOCK(NM)>=T) EXIT
      ENDDO
   ENDIF
   IF (T>=ISOF_CLOCK(NM)) THEN
      IF (SYNCHRONIZE) THEN
         CALL DUMP_ISOF(T,NM)
      ELSE
         CALL DUMP_ISOF(ISOF_CLOCK(NM),NM)
      ENDIF
      DO
         ISOF_CLOCK(NM) = ISOF_CLOCK(NM) + DT_ISOF
         IF (ISOF_CLOCK(NM)>=T) EXIT
      ENDDO
   ENDIF
   IF (T>=SLCF_CLOCK(NM)) THEN
      IF (SYNCHRONIZE) THEN
         CALL DUMP_SLCF(T,NM,0)
      ELSE
         CALL DUMP_SLCF(SLCF_CLOCK(NM),NM,0)
      ENDIF
      IF (SMOKE3D) CALL DUMP_SMOKE3D(SLCF_CLOCK(NM),NM)
      DO
         SLCF_CLOCK(NM) = SLCF_CLOCK(NM) + DT_SLCF
         IF (SLCF_CLOCK(NM)>=T) EXIT
      ENDDO
      IF (RAW_DATA_FILE) CALL DUMP_RAW_DATA(NM)
   ENDIF
   IF (T>=BNDF_CLOCK(NM)) THEN
      IF (SYNCHRONIZE) THEN
         CALL DUMP_BNDF(T,NM)
      ELSE
         CALL DUMP_BNDF(BNDF_CLOCK(NM),NM)
      ENDIF
      IF(TERRAIN_CASE)THEN
         IF (SYNCHRONIZE) THEN
            CALL DUMP_BNDF_TO_SLCF(T,NM)
         ELSE
            CALL DUMP_BNDF_TO_SLCF(BNDF_CLOCK(NM),NM)
         ENDIF
      ENDIF
      DO
         BNDF_CLOCK(NM) = BNDF_CLOCK(NM) + DT_BNDF
         IF (BNDF_CLOCK(NM)>=T) EXIT
      ENDDO
   ENDIF
   IF (T>=PL3D_CLOCK(NM) .OR. PROCESS_STOP_STATUS/=NO_STOP) THEN
      CALL DUMP_SLCF(T,NM,1)
      DO
         PL3D_CLOCK(NM) = PL3D_CLOCK(NM) + DT_PL3D
         IF (PL3D_CLOCK(NM)>=T) EXIT
      ENDDO
   ENDIF
   IF (T>=PROF_CLOCK(NM)) THEN
      IF (SYNCHRONIZE) THEN
         CALL DUMP_PROF(T,NM)
      ELSE
         CALL DUMP_PROF(PROF_CLOCK(NM),NM)
      ENDIF
      DO
         PROF_CLOCK(NM) = PROF_CLOCK(NM) + DT_PROF
         IF (PROF_CLOCK(NM)>=T) EXIT
      ENDDO
   ENDIF
   IF (T>=CORE_CLOCK(NM) .OR. PROCESS_STOP_STATUS==USER_STOP) THEN
      CALL DUMP_CORE(T,NM)
      CORE_CLOCK(NM) = CORE_CLOCK(NM) + DT_RESTART
   ENDIF
ENDIF EVACUATION_DUMP

TUSED(7,NM) = TUSED(7,NM) + SECOND() - TNOW
END SUBROUTINE DUMP_MESH_OUTPUTS



SUBROUTINE ASSIGN_FILE_NAMES
 
! Assign names and logical units for all output files
 
INTEGER :: NM,I,N
INTEGER :: N_TREE
CHARACTER(30) :: CFORM

! Set up file number counter

ALLOCATE(FILE_COUNTER(0:NUMPROCS))
FILE_COUNTER = 10
 
! Endian File

FN_END = TRIM(CHID)//'.end'

! Smokeview File

FN_SMV = TRIM(CHID)//'.smv'

! Diagnostic Output File

FN_OUTPUT = TRIM(CHID)//'.out'

! Mass and HRR Files

IF (MASS_FILE) THEN
   LU_MASS  = GET_FILE_NUMBER()
   FN_MASS  = TRIM(CHID)//'_mass.csv'
ENDIF

LU_HRR   = GET_FILE_NUMBER()
FN_HRR   = TRIM(CHID)//'_hrr.csv'

! Device and Control Files

IF (COLUMN_DUMP_LIMIT) THEN 
   N_DEVC_FILES = N_DEVC_TIME / DEVC_COLUMN_LIMIT
   IF (N_DEVC_FILES * DEVC_COLUMN_LIMIT < N_DEVC_TIME) N_DEVC_FILES = N_DEVC_FILES + 1
   N_CTRL_FILES = N_CTRL / CTRL_COLUMN_LIMIT
   IF (N_CTRL_FILES * CTRL_COLUMN_LIMIT < N_CTRL) N_CTRL_FILES = N_CTRL_FILES + 1
ELSE
   IF (N_DEVC_TIME >= 1) N_DEVC_FILES = 1
   IF (N_CTRL >= 1)      N_CTRL_FILES = 1
ENDIF

ALLOCATE(LU_DEVC(N_DEVC_FILES))
ALLOCATE(FN_DEVC(N_DEVC_FILES))
ALLOCATE(LU_CTRL(N_CTRL_FILES))
ALLOCATE(FN_CTRL(N_CTRL_FILES))

DO I=1,N_DEVC_FILES
   LU_DEVC(I) = GET_FILE_NUMBER()
   WRITE(FN_DEVC(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_devc.csv'
ENDDO         
IF (N_DEVC_FILES==1) FN_DEVC(1) = TRIM(CHID)//'_devc.csv'

DO I=1,N_CTRL_FILES
   LU_CTRL(I) = GET_FILE_NUMBER()
   WRITE(FN_CTRL(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_ctrl.csv'
ENDDO         
IF (N_CTRL_FILES==1) FN_CTRL(1) = TRIM(CHID)//'_ctrl.csv'

! Line files

IF (N_DEVC_LINE>0) THEN
   LU_LINE = GET_FILE_NUMBER()
   FN_LINE = TRIM(CHID)//'_line.csv'
ENDIF

! Profile Files

ALLOCATE(LU_PROF(N_PROF))
ALLOCATE(FN_PROF(N_PROF))

DO N=1,N_PROF
   LU_PROF(N) = GET_FILE_NUMBER()
   IF (N_PROF <100) CFORM = '(A,A,I2.2,A)'
   IF (N_PROF>=100) CFORM = '(A,A,I3.3,A)'
   WRITE(FN_PROF(N),CFORM) TRIM(CHID),'_prof_',N,'.csv'
ENDDO

! State Relation File(s)

IF (STATE_FILE) THEN
   ALLOCATE(LU_STATE(1))
   ALLOCATE(FN_STATE(1))
   LU_STATE(1) = GET_FILE_NUMBER()
   WRITE(FN_STATE(1),'(A,A)') TRIM(CHID),'_state.csv'
ENDIF

! Vegetation File(s) for Fuel Element model

IF (N_TREES_OUT > 0) THEN
  N_TREE = 0
  ALLOCATE(LU_VEG_OUT(N_TREES_OUT))
  ALLOCATE(FN_VEG_OUT(N_TREES_OUT))
  DO N = 1,N_TREES 
    N_TREE = N_TREE_OUT(N)
    IF (N_TREE /= 0) THEN
      LU_VEG_OUT(N_TREE) = GET_FILE_NUMBER()
      WRITE(FN_VEG_OUT(N_TREE),'(A,A,A,A)') TRIM(CHID),'_',TRIM(VEG_LABELS(N)), &
                                            '_vegout.csv'
    ENDIF
  ENDDO
ENDIF

! Plot3D

ALLOCATE(FN_XYZ(NMESHES))
ALLOCATE(LU_XYZ(NMESHES))
ALLOCATE(FN_PL3D(NMESHES))
ALLOCATE(LU_PL3D(NMESHES))

ALLOCATE(FN_ISOF(N_ISOF,NMESHES))
ALLOCATE(LU_ISOF(N_ISOF,NMESHES))
ALLOCATE(FN_SLCF(N_SLCF_MAX,NMESHES))
ALLOCATE(LU_SLCF(N_SLCF_MAX,NMESHES))
ALLOCATE(FN_BNDF(N_BNDF,NMESHES))
ALLOCATE(LU_BNDF(N_BNDF,NMESHES))
IF(TERRAIN_CASE)THEN
  ALLOCATE(FN_BNDF_SLCF(N_BNDF,NMESHES))
  ALLOCATE(LU_BNDF_SLCF(N_BNDF,NMESHES))
ENDIF
ALLOCATE(FN_SMOKE3D(2,NMESHES))
ALLOCATE(LU_SMOKE3D(2,NMESHES))
ALLOCATE(FN_PART(NMESHES))
ALLOCATE(LU_PART(NMESHES))
ALLOCATE(FN_CORE(NMESHES))
ALLOCATE(LU_CORE(NMESHES))
ALLOCATE(FN_RESTART(NMESHES))
ALLOCATE(LU_RESTART(NMESHES))

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID) CYCLE MESH_LOOP

   M => MESHES(NM)

   ! Plot3D Files

   LU_XYZ(NM)  = GET_FILE_NUMBER()
   LU_PL3D(NM) = GET_FILE_NUMBER()
   IF (NMESHES >1) WRITE(FN_XYZ(NM),'(A,A,I4.4,A)') TRIM(CHID),'_',NM,'.xyz'
   IF (NMESHES==1) WRITE(FN_XYZ(NM),'(A,A)')        TRIM(CHID),       '.xyz'

   DO N=1,N_ISOF
      IF (NMESHES >1) WRITE(FN_ISOF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.iso'
      IF (NMESHES==1) WRITE(FN_ISOF(N,NM),'(A,A,I2.2,A)')        TRIM(CHID),'_',N,'.iso'
   ENDDO

   IF (NMESHES >1) WRITE(FN_SMOKE3D(1,NM),'(A,A,I4.4,A)') TRIM(CHID),'_',NM,'_01.s3d'
   IF (NMESHES==1) WRITE(FN_SMOKE3D(1,NM),'(A,A)')        TRIM(CHID),       '_01.s3d'
   IF (NMESHES >1) WRITE(FN_SMOKE3D(2,NM),'(A,A,I4.4,A)') TRIM(CHID),'_',NM,'_02.s3d'
   IF (NMESHES==1) WRITE(FN_SMOKE3D(2,NM),'(A,A)')        TRIM(CHID),       '_02.s3d'

   ! Slice Files

   DO N=1,M%N_SLCF
      LU_SLCF(N,NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         IF (M%N_SLCF <100) CFORM = '(A,A,I4.4,A,I2.2,A)'
         IF (M%N_SLCF>=100) CFORM = '(A,A,I4.4,A,I3.3,A)'
         WRITE(FN_SLCF(N,NM),CFORM) TRIM(CHID),'_',NM,'_',N,'.sf'
      ELSE
         IF (M%N_SLCF <100) CFORM = '(A,A,I2.2,A)'
         IF (M%N_SLCF>=100) CFORM = '(A,A,I3.3,A)'
         WRITE(FN_SLCF(N,NM),CFORM) TRIM(CHID),'_',N,'.sf'
      ENDIF
   ENDDO

   ! Boundary Files

   DO N=1,N_BNDF
      LU_BNDF(N,NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         WRITE(FN_BNDF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.bf'
      ELSE
         WRITE(FN_BNDF(N,NM),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'.bf'
      ENDIF
   ENDDO

   ! Boundary Files mapped to slice files for terrain cases

   IF(TERRAIN_CASE) THEN
      DO N=1,N_BNDF
         LU_BNDF_SLCF(N,NM) = GET_FILE_NUMBER()
         IF (NMESHES>1) THEN
            WRITE(FN_BNDF_SLCF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'_bf.sf'
         ELSE
            WRITE(FN_BNDF_SLCF(N,NM),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'_bf.sf'
         ENDIF
      ENDDO
   ENDIF
   ! Particle Files

   IF (DROPLET_FILE .AND. .NOT.EVACUATION_ONLY(NM)) THEN
      LU_PART(NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         WRITE(FN_PART(NM),'(A,I4.4,A)') TRIM(CHID)//'_',NM,'.prt5'
      ELSE
         WRITE(FN_PART(NM),'(A,A)') TRIM(CHID),'.prt5'
      ENDIF
   ENDIF

   ! Particle Files for Evacuation

   IF (EVACUATION_GRID(NM)) THEN
      LU_PART(NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         WRITE(FN_PART(NM),'(A,I4.4,A)') TRIM(CHID)//'_',NM,'.prt5'
      ELSE
         WRITE(FN_PART(NM),'(A,A)') TRIM(CHID),'.prt5'
      ENDIF
   ENDIF

   ! Restart Files

   LU_RESTART(NM) = GET_FILE_NUMBER()
   WRITE(FN_RESTART(NM),'(A,A,I4.4,A)') TRIM(RESTART_CHID),'_',NM,'.restart'
   LU_CORE(NM)    = GET_FILE_NUMBER()
   WRITE(FN_CORE(NM),   '(A,A,I4.4,A)') TRIM(CHID),'_',NM,'.restart'

ENDDO MESH_LOOP

! Status File

IF (STATUS_FILES) THEN
   LU_NOTREADY = GET_FILE_NUMBER()
   FN_NOTREADY = TRIM(CHID)//'.notready'
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   LU_VELOCITY_ERROR = GET_FILE_NUMBER()
   FN_VELOCITY_ERROR = TRIM(CHID)//'_pressit.csv'
ENDIF

END SUBROUTINE ASSIGN_FILE_NAMES



SUBROUTINE INITIALIZE_GLOBAL_DUMPS

! Open and initialize all files that are not tied to a particular mesh

USE COMP_FUNCTIONS, ONLY: SECOND
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION_ALL,GET_MOLECULAR_WEIGHT
USE CONTROL_VARIABLES
REAL(EB) :: ZZ,Y_MF(1:N_Y_ARRAY),MW_MF,TNOW,Z_F,Y_VECTOR(1:N_SPECIES)
INTEGER :: NN,IZ,I,N
CHARACTER(30), DIMENSION(20) :: LABEL

TNOW=SECOND() 

! Open and initialize diagnostic output file
 
IF (APPEND) THEN
   INQUIRE(FILE=FN_OUTPUT,EXIST=EX)
   IF (EX) OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ELSE
   OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='REPLACE')
ENDIF
 
CALL INITIALIZE_DIAGNOSTIC_FILE

! Initialize device output file (CHID_devc.csv)
 
IF (N_DEVC_TIME>0) THEN

   ALLOCATE(TIME_DEVC_LABEL(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_UNITS(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_VALUE(N_DEVC_TIME))
   
   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE==0) THEN
         NN = NN + 1
         TIME_DEVC_LABEL(NN) = DV%ID
         TIME_DEVC_UNITS(NN) = DV%UNITS
      ENDIF
   ENDDO

   IF (COLUMN_DUMP_LIMIT) THEN
      DO I = 1,N_DEVC_FILES
         IF (APPEND) THEN
            OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
         ELSE
            OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='REPLACE')
            WRITE(TCFORM,'(A,I4.4,A)') "(",MIN(DEVC_COLUMN_LIMIT, N_DEVC_TIME - DEVC_COLUMN_LIMIT * (I - 1)),"(A,','),A)"
            WRITE(LU_DEVC(I),TCFORM) 's',(TRIM(TIME_DEVC_UNITS(N)),N=DEVC_COLUMN_LIMIT*(I-1)+1,MIN(N_DEVC_TIME,I*DEVC_COLUMN_LIMIT))
            WRITE(TCFORM,'(A,I4.4,A)') "(A,",MIN(DEVC_COLUMN_LIMIT, N_DEVC_TIME - DEVC_COLUMN_LIMIT * (I - 1)),"(',',3A))"
            WRITE(LU_DEVC(I),TCFORM) 'FDS Time',('"',TRIM(TIME_DEVC_LABEL(N)),'"', &
                                             N=DEVC_COLUMN_LIMIT * (I - 1) + 1,MIN(N_DEVC_TIME, I * DEVC_COLUMN_LIMIT))
         ENDIF
      ENDDO
   ELSE
      IF (APPEND) THEN
         OPEN(LU_DEVC(1),FILE=FN_DEVC(1),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
      ELSE
         OPEN(LU_DEVC(1),FILE=FN_DEVC(1),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(TCFORM,'(A,I4.4,A)') "(",N_DEVC_TIME,"(A,','),A)"
         WRITE(LU_DEVC(1),TCFORM) 's',(TRIM(TIME_DEVC_UNITS(N)),N=1,N_DEVC_TIME)
         WRITE(TCFORM,'(A,I4.4,A)') "(A,",N_DEVC_TIME,"(',',3A))"
         WRITE(LU_DEVC(1),TCFORM) 'FDS Time',('"',TRIM(TIME_DEVC_LABEL(N)),'"',N=1,N_DEVC_TIME)
      ENDIF
   ENDIF

ENDIF

! Define labels for line devices

IF (N_DEVC_LINE>0) THEN

   ALLOCATE(LINE_DEVC_LABEL(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_UNITS(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_VALUE(N_DEVC_LINE,MAX_DEVC_LINE_POINTS))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0 .AND. DV%POINT==1) THEN
         NN = NN+1
         LINE_DEVC_LABEL(NN) = TRIM(DV%ID)//'-x,'//TRIM(DV%ID)//'-y,'//TRIM(DV%ID)//'-z,'//TRIM(DV%ID)
         LINE_DEVC_UNITS(NN) = 'm,m,m,'//TRIM(DV%UNITS)
      ENDIF
   ENDDO

ENDIF

! Initialize control output file (CHID_ctrl.csv)
 
IF (N_CTRL>0) THEN
   IF (COLUMN_DUMP_LIMIT) THEN
      DO I = 1,N_CTRL_FILES
         IF (APPEND) THEN
            OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
         ELSE
            OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='REPLACE')
            WRITE(TCFORM,'(A,I4.4,A)') "(",MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1)),"(A,','),A)"
            WRITE(LU_CTRL(I),TCFORM) 's',('status',N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
            WRITE(TCFORM,'(A,I4.4,A)') "(A,",MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1)),"(',',3A))"
            WRITE(LU_CTRL(I),TCFORM) 'FDS Time',('"',TRIM(CONTROL(N)%ID),'"', &
                                      N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
         ENDIF
      ENDDO
   ELSE
      IF (APPEND) THEN
         OPEN(LU_CTRL(1),FILE=FN_CTRL(1),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
      ELSE
         OPEN(LU_CTRL(1),FILE=FN_CTRL(1),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(TCFORM,'(A,I4.4,A)') "(",N_CTRL,"(A,','),A)"
         WRITE(LU_CTRL(1),TCFORM) 's',('status',N=1,N_CTRL)
            WRITE(TCFORM,'(A,I4.4,A)') "(A,",N_CTRL,"(',',3A))"
            WRITE(LU_CTRL(I),TCFORM) 'FDS Time',('"',TRIM(CONTROL(N)%ID),'"',N=1,N_CTRL)
      ENDIF
   ENDIF
ENDIF

! Open heat release rate file (CHID_hrr.csv)

IF (APPEND) THEN
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ELSE
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(TCFORM,'(A,I4.4,A)') "(",5+N_ZONE,"(A,','),A)"
   WRITE(LU_HRR,TCFORM) 's','kW','kW','kW','kW','kg/s',('atm',N=1,N_ZONE) 
   WRITE(LU_HRR,TCFORM) 'FDS_HRR_Time','HRR','RAD_LOSS','CONV_LOSS','COND_LOSS','BURN_RATE',(TRIM(P_ZONE(N)%ID),N=1,N_ZONE) 
ENDIF


! Open vegetation ouput files(s) for Fuel Element model

DO N=1,N_TREES_OUT 
 IF (APPEND) THEN
    OPEN(LU_VEG_OUT(N),FILE=FN_VEG_OUT(N),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
 ELSE
    OPEN(LU_VEG_OUT(N),FILE=FN_VEG_OUT(N),FORM='FORMATTED',STATUS='REPLACE')
    WRITE(LU_VEG_OUT(N),'(A,A,A,A,A)')'s,','kg,','kg, ','kW, ','kW' 
    WRITE(LU_VEG_OUT(N),'(A,A,A,A,A)')'FDS_Vegout_Time,','Total_Tree_Dry_Mass,','Total_Tree_Moist_Mass, ', &
                                         'total_int_div(qveg_conv)dVe, ','total_int_div(qveg_rad)dVe'
 ENDIF
ENDDO
 
! Write out info about mixture fraction-based state relationships for all mixture fraction SPECies
 
IF (MIXTURE_FRACTION .AND. STATE_FILE) THEN
   OPEN(LU_STATE(1),FILE=FN_STATE(1),FORM='FORMATTED',STATUS='REPLACE')
   WRITE(TCFORM,'(A,I4.4,A)') "(",N_STATE_SPECIES+1,"(A,','),A)"
   WRITE(LU_STATE(1),TCFORM) ('kg/kg',NN=1,N_STATE_SPECIES+1),'g/mol'
   LABEL(1) = 'Z'
   LABEL(2:2+N_STATE_SPECIES-1) = MF_SPEC_FORMULA(1:N_STATE_SPECIES)
   LABEL(2+N_STATE_SPECIES) = 'Wgt'
   WRITE(LU_STATE(1),TCFORM) LABEL(1:N_STATE_SPECIES+2)
   Y_VECTOR=0._EB
   SOOT_DEP_IF: IF (SOOT_DEPOSITION) THEN
      IF (CO_PRODUCTION) THEN
         Z_F = REACTION(2)%Z_F
         DO IZ=0,1000
            ZZ = IZ/REAL(1000,EB)
            IF (ZZ<Z_F) THEN
               Y_VECTOR(I_Z_MIN)   = 0._EB
               Y_VECTOR(I_Z_MIN+1) = ZZ * REACTION(2)%CO_YIELD / MW_CO/REACTION(1)%NU(CO_INDEX)*REACTION(1)%MW_FUEL
               Y_VECTOR(I_Z_MAX)   = ZZ * REACTION(2)%SOOT_YIELD   
               Y_VECTOR(I_Z_MIN+2) = ZZ - Y_VECTOR(I_Z_MIN+1) - Y_VECTOR(I_Z_MAX)
            ELSE
               Y_VECTOR(I_Z_MIN)   = REACTION(2)%Y_F_INLET*(ZZ-Z_F)/(1._EB-Z_F)
               Y_VECTOR(I_Z_MIN+1) = (ZZ-Y_VECTOR(I_Z_MIN))*REACTION(2)%CO_YIELD/MW_CO/REACTION(1)%NU(CO_INDEX)*REACTION(1)%MW_FUEL
               Y_VECTOR(I_Z_MAX)   = (ZZ - Y_VECTOR(I_Z_MIN)) * REACTION(2)%SOOT_YIELD
               Y_VECTOR(I_Z_MIN+2) = ZZ - Y_VECTOR(I_Z_MIN) - Y_VECTOR(I_Z_MIN+1) - Y_VECTOR(I_Z_MAX)
            ENDIF
            CALL GET_MASS_FRACTION_ALL(Y_VECTOR,Y_MF)
            CALL GET_MOLECULAR_WEIGHT(Y_VECTOR,MW_MF)
            WRITE(LU_STATE(1),'(10(ES12.4,","),ES12.4)') ZZ,Y_MF(1:N_STATE_SPECIES),MW_MF
         ENDDO
      ELSE
         Z_F = REACTION(1)%Z_F
         DO IZ=0,1000
            ZZ = IZ/REAL(1000,EB)
            IF (ZZ<Z_F) THEN
               Y_VECTOR(I_Z_MIN)   = 0._EB
               Y_VECTOR(I_Z_MAX)   = ZZ * REACTION(1)%SOOT_YIELD   
               Y_VECTOR(I_Z_MIN+1) = ZZ * (1._EB - REACTION(1)%SOOT_YIELD)
            ELSE
               Y_VECTOR(I_Z_MIN)   = REACTION(1)%Y_F_INLET*(ZZ-Z_F)/(1._EB-Z_F)
               Y_VECTOR(I_Z_MAX)   = (ZZ - Y_VECTOR(I_Z_MIN)) * REACTION(1)%SOOT_YIELD
               Y_VECTOR(I_Z_MIN+1) = (ZZ - Y_VECTOR(I_Z_MIN)) * (1._EB - REACTION(1)%SOOT_YIELD)
            ENDIF
            CALL GET_MASS_FRACTION_ALL(Y_VECTOR,Y_MF)
            CALL GET_MOLECULAR_WEIGHT(Y_VECTOR,MW_MF)
            WRITE(LU_STATE(1),'(10(ES12.4,","),ES12.4)') ZZ,Y_MF(1:N_STATE_SPECIES),MW_MF
         ENDDO  
      ENDIF 
   ELSE SOOT_DEP_IF
      IF (CO_PRODUCTION) THEN
         Z_F = REACTION(2)%Z_F
         DO IZ=0,1000
            ZZ = IZ/REAL(1000,EB)
            IF (ZZ<Z_F) THEN
               Y_VECTOR(I_Z_MIN) = 0._EB
               Y_VECTOR(I_Z_MIN+1) = ZZ * REACTION(2)%CO_YIELD / MW_CO/REACTION(1)%NU(CO_INDEX)*REACTION(1)%MW_FUEL   
               Y_VECTOR(I_Z_MIN+2) = ZZ - Y_VECTOR(I_Z_MIN+1)
            ELSE
               Y_VECTOR(I_Z_MIN) = REACTION(2)%Y_F_INLET*(ZZ-Z_F)/(1._EB-Z_F)
               Y_VECTOR(I_Z_MIN+1) = (ZZ-Y_VECTOR(I_Z_MIN))*REACTION(2)%CO_YIELD/MW_CO/REACTION(1)%NU(CO_INDEX)*REACTION(1)%MW_FUEL
               Y_VECTOR(I_Z_MIN+2) = ZZ - Y_VECTOR(I_Z_MIN) - Y_VECTOR(I_Z_MIN+1)
            ENDIF
            CALL GET_MASS_FRACTION_ALL(Y_VECTOR,Y_MF)
            CALL GET_MOLECULAR_WEIGHT(Y_VECTOR,MW_MF)
            WRITE(LU_STATE(1),'(10(ES12.4,","),ES12.4)') ZZ,Y_MF(1:N_STATE_SPECIES),MW_MF
         ENDDO
      ELSE
         Z_F = REACTION(1)%Z_F
         DO IZ=0,1000
            ZZ = IZ/REAL(1000,EB)
            IF (ZZ<Z_F) THEN
               Y_VECTOR(I_Z_MIN) = 0._EB
               Y_VECTOR(I_Z_MIN+1) = ZZ
            ELSE
               Y_VECTOR(I_Z_MIN) = REACTION(1)%Y_F_INLET*(ZZ-Z_F)/(1._EB-Z_F)
               Y_VECTOR(I_Z_MIN+1) = ZZ - Y_VECTOR(I_Z_MIN)
            ENDIF
            CALL GET_MASS_FRACTION_ALL(Y_VECTOR,Y_MF)
            CALL GET_MOLECULAR_WEIGHT(Y_VECTOR,MW_MF)
            WRITE(LU_STATE(1),'(10(ES12.4,","),ES12.4)') ZZ,Y_MF(1:N_STATE_SPECIES),MW_MF
         ENDDO  
      ENDIF
   ENDIF SOOT_DEP_IF
   CLOSE(LU_STATE(1))
ENDIF

! Open species mass file
 
IF_DUMP_SPECIES_INFO: IF (MASS_FILE) THEN
   IF (APPEND) THEN
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='REPLACE')
      IF (MIXTURE_FRACTION) THEN
         LABEL(1) = 'Time'
         LABEL(2) = 'Total'
         LABEL(3:3+N_STATE_SPECIES-1) = MF_SPEC_ID(1:N_STATE_SPECIES)
         NN = 3+N_STATE_SPECIES-1
         DO N=1,N_SPECIES
            IF (SPECIES(N)%MODE==GAS_SPECIES .AND. SPECIES(N)%INDEX > N_STATE_SPECIES) THEN
               NN = NN+1
               LABEL(NN) = SPECIES(N)%ID
            ENDIF
         ENDDO
         WRITE(TCFORM,'(A,I4.4,A)') "(",NN-1,"(A,','),A)"
         WRITE(LU_MASS,TCFORM) 's',('kg',N=1,NN-1)
         WRITE(LU_MASS,TCFORM) (TRIM(LABEL(N)),N=1,NN)
      ELSE
         WRITE(TCFORM,'(A,I4.4,A)') "(",N_SPECIES+1,"(A,','),A)"
         WRITE(LU_MASS,TCFORM) 's',('kg',N=0,N_SPECIES)
         WRITE(LU_MASS,TCFORM)'FDS Time','Total',(TRIM(SPECIES(N)%ID),N=1,N_SPECIES)
      ENDIF
   ENDIF
ENDIF IF_DUMP_SPECIES_INFO

! Special output dump for UL pan test data

IF (UL_PAN_DATA) THEN
   LU_UL_PAN_DATA = GET_FILE_NUMBER()
   OPEN(LU_UL_PAN_DATA,FILE=TRIM(CHID)//'_awmpua.csv',FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU_UL_PAN_DATA,'(A)') 'T, XW(IW), YW(IW), ZW(IW), PP(I-J)'
ENDIF

! Special output for pressure iteration scheme
IF (VELOCITY_ERROR_FILE) THEN
   OPEN(UNIT=LU_VELOCITY_ERROR,FILE=FN_VELOCITY_ERROR,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   WRITE(LU_VELOCITY_ERROR,'(A)') 'ICYC, PRESS IT, VELOCITY_ERROR_MAX'
ENDIF

TUSED(7,:) = TUSED(7,:) + SECOND() - TNOW
END SUBROUTINE INITIALIZE_GLOBAL_DUMPS
 
 
SUBROUTINE INITIALIZE_MESH_DUMPS(NM)
USE COMP_FUNCTIONS, ONLY : SECOND
USE MEMORY_FUNCTIONS, ONLY:RE_ALLOCATE_STRINGS,CHKMEMERR 
INTEGER, INTENT(IN) :: NM
INTEGER :: IOR,IZERO,I,J,K,N,ERROR,I1,I2,J1,J2,K1,K2,I1B,I2B,IW,NN,NF
INTEGER :: NTSL
CHARACTER(30) :: LABEL1,LABEL2,LABEL3
REAL(EB) :: TNOW
 
TNOW=SECOND() 
 
M => MESHES(NM)
 
IBAR=>M%IBAR
JBAR=>M%JBAR
KBAR=>M%KBAR
IBP1=>M%IBP1
JBP1=>M%JBP1
KBP1=>M%KBP1
 
! Compute grid coords in single precision for output
 
ALLOCATE(M%XPLT(0:IBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','XPLT',IZERO)
ALLOCATE(M%YPLT(0:JBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','YPLT',IZERO)
ALLOCATE(M%ZPLT(0:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','ZPLT',IZERO)
 
DO I=0,IBAR
   M%XPLT(I) = M%X(I)
ENDDO
DO J=0,JBAR
   M%YPLT(J) = M%Y(J)
ENDDO
DO K=0,KBAR
   M%ZPLT(K) = M%Z(K)
ENDDO
 
! Initialize PLOT3D grid file (CHID.xyz)
 
IF (.NOT.EVACUATION_ONLY(NM)) THEN
   ALLOCATE(M%IBLK(0:IBAR,0:JBAR,0:KBAR),STAT=IZERO)
   CALL ChkMemErr('DUMP','IBLK',IZERO)
ENDIF
ALLOCATE(M%QQ(0:IBP1,0:JBP1,0:KBP1,5),STAT=IZERO)
CALL ChkMemErr('DUMP','QQ',IZERO)
M%QQ=0._FB
 
WRITE_XYZ_FILE: IF (WRITE_XYZ .AND..NOT.EVACUATION_ONLY(NM)) THEN
   OPEN(LU_XYZ(NM),FILE=FN_XYZ(NM),FORM='UNFORMATTED',STATUS='REPLACE')
   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            IF (M%SOLID(M%CELL_INDEX(I,J,K))    .AND. M%SOLID(M%CELL_INDEX(I+1,J,K))   .AND. &
                M%SOLID(M%CELL_INDEX(I,J+1,K))  .AND. M%SOLID(M%CELL_INDEX(I,J,K+1))   .AND. &
                M%SOLID(M%CELL_INDEX(I+1,J+1,K)).AND. M%SOLID(M%CELL_INDEX(I+1,J,K+1)) .AND. &
                M%SOLID(M%CELL_INDEX(I,J+1,K+1)).AND. M%SOLID(M%CELL_INDEX(I+1,J+1,K+1)) ) THEN
               M%IBLK(I,J,K) = 0
            ELSE
               M%IBLK(I,J,K) = 1
            ENDIF
         ENDDO   
      ENDDO   
   ENDDO   
   WRITE(LU_XYZ(NM)) IBP1,JBP1,KBP1
   WRITE(LU_XYZ(NM)) (((M%XPLT(I),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%YPLT(J),I=0,IBAR),J=0,JBAR),K=0,KBAR), &
                     (((M%ZPLT(K),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%IBLK(I,J,K),I=0,IBAR),J=0,JBAR),K=0,KBAR)
   CLOSE(LU_XYZ(NM))
   IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
   ENDIF
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(A)') 'XYZ'
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_XYZ(NM))
ENDIF WRITE_XYZ_FILE
 
! Re-allocate IBLK array for use with isosurface generation
 
IF (.NOT.EVACUATION_ONLY(NM)) THEN
   DEALLOCATE(M%IBLK)
   ALLOCATE(M%IBLK(1:IBAR,1:JBAR,1:KBAR),STAT=IZERO)
   CALL ChkMemErr('DUMP','IBLK',IZERO)
ENDIF
 
! Initialize isosurface file
 
IF (.NOT.APPEND .AND. .NOT.EVACUATION_ONLY(NM)) THEN
 
   DO N=1,N_ISOF
      IS => ISOSURFACE_FILE(N)
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (IS%INDEX2==0) THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'ISOF',NM
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'TISOF',NM
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_ISOF(N,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX)%UNITS)
      IF (IS%INDEX2/=0) THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL2)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL2)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX2)%UNITS)
      ENDIF
       
      LABEL1 = TRIM(IS%SMOKEVIEW_LABEL)//CHAR(0)
      LABEL2 = TRIM(IS%SMOKEVIEW_BAR_LABEL)//CHAR(0)
      LABEL3 = TRIM(OUTPUT_QUANTITY(IS%INDEX)%UNITS)//CHAR(0)
      ERROR = 0
      IF (IS%INDEX2==0) CALL ISOHEADER(TRIM(FN_ISOF(N,NM))//CHAR(0),LABEL1,LABEL2,LABEL3, &
                                       IS%VALUE(1:IS%N_VALUES),IS%N_VALUES,ERROR)
      IF (IS%INDEX2/=0) CALL TISOHEADER(TRIM(FN_ISOF(N,NM))//CHAR(0),LABEL1,LABEL2,LABEL3, &
                                        IS%VALUE(1:IS%N_VALUES),IS%N_VALUES,ERROR)
   ENDDO
 
ENDIF
 
! Initialize Smoke3d file
 
SMOKE3D_INITIALIZATION: IF (SMOKE3D .AND..NOT.EVACUATION_ONLY(NM)) THEN
 
   IF (.NOT.APPEND) THEN
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'SMOKE3D',NM
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SMOKE3D(1,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SMOKE3D_QUANTITY_INDEX)%UNITS)
      CALL SMOKE3DHEADER(TRIM(FN_SMOKE3D(1,NM))//CHAR(0),0,M%IBAR,0,M%JBAR,0,M%KBAR)
   ENDIF
    
   IF (.NOT.APPEND .AND. SMOKE3D_QUANTITY_INDEX/=11) THEN
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF(USE_HRRPUV_MAX_SMV.EQ.1)THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,E13.6)') 'VSMOKE3D',NM,HRRPUV_MAX_SMV
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'SMOKE3D',NM
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SMOKE3D(2,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(11)%NAME)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(11)%SHORT_NAME)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(11)%UNITS)
      CALL SMOKE3DHEADER(TRIM(FN_SMOKE3D(2,NM))//CHAR(0),0,M%IBAR,0,M%JBAR,0,M%KBAR)
   ENDIF
 
ENDIF SMOKE3D_INITIALIZATION
 
! Initialize Slice Files
 
NTSL = 0

DO N=1,M%N_SLCF
   SL => M%SLICE(N)
   IF (APPEND) THEN
      OPEN(LU_SLCF(N,NM),FILE=FN_SLCF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (.NOT.SL%TERRAIN_SLICE .AND. .NOT.SL%CELL_CENTERED) WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'SLCF',NM
      IF (SL%CELL_CENTERED)                                  WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'SLCC',NM
      IF (SL%TERRAIN_SLICE)THEN
        IF (SL%FIRE_LINE) THEN
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4)') 'SLFL',NM,SL%SLICE_AGL
        ELSE
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4)') 'SLCT',NM,SL%SLICE_AGL
        ENDIF
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF(N,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SL%INDEX)%UNITS)
      OPEN(LU_SLCF(N,NM),FILE=FN_SLCF(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) OUTPUT_QUANTITY(SL%INDEX)%UNITS(1:30)
      IF (.NOT. SL%TERRAIN_SLICE) THEN
         WRITE(LU_SLCF(N,NM)) SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
      ELSE
         NTSL = NTSL + 1
         IF (SL%I1 == 0)    M%K_AGL_SLICE(0,SL%J1:SL%J2,NTSL)    = M%K_AGL_SLICE(1,SL%J1:SL%J2,NTSL)
         IF (SL%I2 == IBP1) M%K_AGL_SLICE(IBP1,SL%J1:SL%J2,NTSL) = M%K_AGL_SLICE(IBP1-1,SL%J1:SL%J2,NTSL)
         IF (SL%J1 == 0)    M%K_AGL_SLICE(SL%I1:SL%I2,0,NTSL)    = M%K_AGL_SLICE(SL%I1:SL%I2,1,NTSL)
         IF (SL%J2 == JBP1) M%K_AGL_SLICE(SL%I1:SL%I2,JBP1,NTSL) = M%K_AGL_SLICE(SL%I1:SL%I2,JBP1-1,NTSL)
         WRITE(LU_SLCF(N,NM)) SL%I1,SL%I2,SL%J1,SL%J2,M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
      ENDIF
   ENDIF
ENDDO   
 
! Initialize Boundary Files
 
IF_BOUNDARY_FILES: IF (N_BNDF>0 .AND. .NOT.EVACUATION_ONLY(NM)) THEN
   I1B = MAX(IBP1,JBP1)
   I2B = MAX(JBP1,KBP1)
   ALLOCATE(M%PP(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PP',IZERO)
   M%PP = 0._EB
   ALLOCATE(M%PPN(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PPN',IZERO)
   ALLOCATE(M%IBK(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','IBK',IZERO)
   IF_NOT_APPEND: IF (.NOT.APPEND) THEN
      M%INC = 0
      DO IW=1,M%NWC
         IOR = M%IJKW(4,IW)
         IF (M%BOUNDARY_TYPE(IW)==SOLID_BOUNDARY .OR. M%BOUNDARY_TYPE(IW)==NULL_BOUNDARY) M%INC(IOR,M%OBST_INDEX_W(IW)) = 1
         IF (.NOT.BNDF_DEFAULT .AND. M%OBST_INDEX_W(IW)==0) M%INC(IOR,M%OBST_INDEX_W(IW)) = 0
      ENDDO
      M%NPATCH = 0
      DO N=0,M%N_OBST
         OB=>M%OBSTRUCTION(N)
         DO I=-3,3
            IF (.NOT.OB%SHOW_BNDF(I)) M%INC(I,N) = 0
            IF (M%INC(I,N)==1) M%NPATCH = M%NPATCH + 1 
         ENDDO
      ENDDO
   ENDIF IF_NOT_APPEND
ENDIF IF_BOUNDARY_FILES
 
BOUNDARY_FILES: DO NF=1,N_BNDF

   BF => BOUNDARY_FILE(NF)
 
   IF (M%NPATCH==0) EXIT BOUNDARY_FILES
   IF (EVACUATION_ONLY(NM)) EXIT BOUNDARY_FILES
 
   RESTART: IF (APPEND) THEN
      OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      IF(TERRAIN_CASE)THEN
         OPEN(LU_BNDF_SLCF(NF,NM),FILE=FN_BNDF_SLCF(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      ENDIF
   ELSE RESTART
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (BF%CELL_CENTERED) THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDC',NM,1  
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDF',NM,1  
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_BNDF(NF,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(BF%INDEX)%UNITS)
      OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) OUTPUT_QUANTITY(BF%INDEX)%UNITS(1:30)
      WRITE(LU_BNDF(NF,NM)) M%NPATCH
      IF (M%INC(-3,0)==1) WRITE(LU_BNDF(NF,NM)) 0,IBAR,0,JBAR,KBAR,KBAR,-3,0,NM
      IF (M%INC(-2,0)==1) WRITE(LU_BNDF(NF,NM)) 0,IBAR,JBAR,JBAR,0,KBAR,-2,0,NM
      IF (M%INC(-1,0)==1) WRITE(LU_BNDF(NF,NM)) IBAR,IBAR,0,JBAR,0,KBAR,-1,0,NM
      IF (M%INC( 1,0)==1) WRITE(LU_BNDF(NF,NM))    0,   0,0,JBAR,0,KBAR, 1,0,NM
      IF (M%INC( 2,0)==1) WRITE(LU_BNDF(NF,NM))    0,IBAR,   0,0,0,KBAR, 2,0,NM
      IF (M%INC( 3,0)==1) WRITE(LU_BNDF(NF,NM))    0,IBAR,   0,JBAR,0,0, 3,0,NM
      DO N=1,M%N_OBST
         OB=>M%OBSTRUCTION(N)
         I1 = OB%I1
         I2 = OB%I2
         J1 = OB%J1
         J2 = OB%J2
         K1 = OB%K1
         K2 = OB%K2
         IF (M%INC(-3,N)==1) WRITE(LU_BNDF(NF,NM)) I1,I2,J1,J2,K1,K1,-3,N,NM
         IF (M%INC(-2,N)==1) WRITE(LU_BNDF(NF,NM)) I1,I2,J1,J1,K1,K2,-2,N,NM
         IF (M%INC(-1,N)==1) WRITE(LU_BNDF(NF,NM)) I1,I1,J1,J2,K1,K2,-1,N,NM
         IF (M%INC( 1,N)==1) WRITE(LU_BNDF(NF,NM)) I2,I2,J1,J2,K1,K2, 1,N,NM
         IF (M%INC( 2,N)==1) WRITE(LU_BNDF(NF,NM)) I1,I2,J2,J2,K1,K2, 2,N,NM
         IF (M%INC( 3,N)==1) WRITE(LU_BNDF(NF,NM)) I1,I2,J1,J2,K2,K2, 3,N,NM
      ENDDO
      IF(TERRAIN_CASE)THEN
        IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,F7.2)') 'SLCT ',NM,0.01  
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_BNDF_SLCF(NF,NM))
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(BF%INDEX)%UNITS)
        OPEN(LU_BNDF_SLCF(NF,NM),FILE=FN_BNDF_SLCF(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
        WRITE(LU_BNDF_SLCF(NF,NM)) BF%SMOKEVIEW_LABEL(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) BF%SMOKEVIEW_BAR_LABEL(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) OUTPUT_QUANTITY(BF%INDEX)%UNITS(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) 0,M%IBAR,0,M%JBAR,0,0
      ENDIF
   ENDIF RESTART
 
ENDDO BOUNDARY_FILES
 
! Initialize particle dump file
 
DROPLET_IF: IF ( (DROPLET_FILE .AND. .NOT.EVACUATION_ONLY(NM)).OR. (EVACUATION_ONLY(NM).AND.EVACUATION_GRID(NM)) ) THEN
 
   APPEND_DROPLET_FILE: IF (APPEND) THEN

      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')

   ELSE APPEND_DROPLET_FILE

      IF (M%N_STRINGS+10*N_PART>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      N = M%N_STRINGS_MAX/MAX(1,N_PART)
      IF (N_EVAC>0 .AND. M%N_STRINGS+10*N_EVAC>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      EVAC_ONLY: IF (EVACUATION_ONLY(NM)) THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4)') 'EVA5',NM,EVACUATION_Z_OFFSET(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_PART(NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I3)') N_EVAC
         DO N=1,N_EVAC
            M%N_STRINGS = M%N_STRINGS + 1
            WRITE(M%STRING(M%N_STRINGS),'(I3)') N
         ENDDO
      ELSE
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'PRT5',NM
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_PART(NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I3)') N_PART
!
         DO N=1,N_PART
            IF (M%N_STRINGS + 1 > M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM) !reallocate if # PART lines requires it
            M%N_STRINGS = M%N_STRINGS + 1
            WRITE(M%STRING(M%N_STRINGS),'(I3)') N
         ENDDO
      ENDIF EVAC_ONLY
 
      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_PART(NM)) ONE_INTEGER                ! The number ONE, to indicate file Endian-ness
      WRITE(LU_PART(NM)) NINT(VERSION_NUMBER*100.)  ! FDS version number
      EVAC_ONLY2: IF (EVACUATION_ONLY(NM)) THEN
         WRITE(LU_PART(NM)) N_EVAC
         DO N=1,N_EVAC
            WRITE(LU_PART(NM)) EVAC_N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,EVAC_N_QUANTITIES
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS
            ENDDO
         ENDDO
      ELSE
         WRITE(LU_PART(NM)) N_PART
         DO N=1,N_PART
            PC => PARTICLE_CLASS(N)
            WRITE(LU_PART(NM)) PC%N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,PC%N_QUANTITIES
               WRITE(LU_PART(NM)) PC%SMOKEVIEW_LABEL(NN)(1:30)
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%UNITS
            ENDDO
         ENDDO
      ENDIF EVAC_ONLY2
 
   ENDIF APPEND_DROPLET_FILE
ENDIF DROPLET_IF

! Initialize PROFile data files (CHID_prof_nn.csv)
 
PROF_LOOP: DO N=1,N_PROF
   IF (PROFILE(N)%MESH /= NM) CYCLE PROF_LOOP
   IF (APPEND) THEN
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_PROF(N),'(A)') PROFILE(N)%ID
      WRITE(LU_PROF(N),'(A)') "Time(s), Npoints, Npoints x Depth (mm), Npoints x Value"
      WRITE(LU_PROF(N),*) 
   ENDIF
ENDDO PROF_LOOP

TUSED(7,NM) = TUSED(7,NM) + SECOND() - TNOW
END SUBROUTINE INITIALIZE_MESH_DUMPS
 
 
SUBROUTINE WRITE_SMOKEVIEW_FILE

USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP,CROSS_PRODUCT,NORM2
USE MEMORY_FUNCTIONS, ONLY : CHKMEMERR
USE COMP_FUNCTIONS, ONLY: SHUTDOWN
USE GEOMETRY_FUNCTIONS, ONLY: INTERIOR
USE EVAC, ONLY: N_DOORS, N_EXITS, N_ENTRYS, N_SSTANDS, EVAC_DOORS, EVAC_EXITS, EVAC_ENTRYS, EVAC_SSTANDS, & 
     EVAC_EXIT_TYPE, EVAC_DOOR_TYPE, EVAC_ENTR_TYPE, EVAC_SSTAND_TYPE, NPC_EVAC, N_HOLES, &
     EVACUATION_TYPE, EVAC_HOLE_TYPE, EVACUATION, EVAC_HOLES
INTEGER :: N,NN,I,J,K,NM,NX,NY,NZ,NIN,NXL,NYL,NZL,NDV,NDVDIM,COLOR_INDEX,IZERO,EVAC_CODE,STATE_INDEX,IBC,&
           TYPE_INDEX,HI1,HI2,VI1,VI2,FACE_INDEX,VRGB(3)
INTEGER, ALLOCATABLE, DIMENSION(:) :: IDV1,IDV2,JDV1,JDV2,KDV1,KDV2,DUMMY_VENT_INDEX
INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: VENT_INDICES
REAL(EB) :: X1,Y1,Z1,X2,Y2,Z2,XX,YY,ZZ,PERT1(4),PERT2(4),XMIN,YMIN,ZMIN,XA,YA,ZA
TYPE SEGMENT_TYPE
REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2
END TYPE SEGMENT_TYPE
TYPE (SEGMENT_TYPE), ALLOCATABLE, TARGET, DIMENSION(:) :: SEGMENT
TYPE (SEGMENT_TYPE), POINTER :: SEG=>NULL()
INTEGER :: N_SEGMENTS_MAX
TYPE (MESH_TYPE), POINTER :: MX=>NULL(),MY=>NULL(),MZ=>NULL()
TYPE (TRAN_TYPE), POINTER :: T=>NULL()
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XLEVEL,YLEVEL,ZLEVEL
CHARACTER(80) PROCESS_FN_SMV
LOGICAL :: EX
CHARACTER(100) :: MESSAGE
CHARACTER(33) :: TEMPCHAR
REAL(EB) :: CROWN_HEIGHT
CHARACTER(30) :: VEG_DEVICE
TYPE (GEOMETRY_TYPE), POINTER :: G=>NULL()
REAL(EB) :: THETA,UU(3)=0._EB,EYE(3,3)=0._EB,PP(3,3)=0._EB,QQ(3,3)=0._EB,RR(3,3)=0._EB,VOR(3),VOR_DEFAULT(3)

! If this is an MPI job and this is not the master node, open the .smv file only if this is not a RESTART case

IF (MYID>0 .AND. APPEND) RETURN

IF (MYID>0 .AND.      SHARED_FILE_SYSTEM) OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')

IF (MYID>0 .AND. .NOT.SHARED_FILE_SYSTEM) THEN
   WRITE(PROCESS_FN_SMV,'(A,A,I3.3,A)') TRIM(CHID),'_',MYID,'.smv'
   OPEN(LU_SMV,FILE=PROCESS_FN_SMV,FORM='FORMATTED', STATUS='REPLACE')
ENDIF

! Do the following printouts only for master node
 
MASTER_NODE_IF: IF (MYID==0) THEN

! Open up the Smokeview ".smv" file

INQUIRE(FILE=FN_SMV,EXIST=EX)
IF (.NOT.EX .AND. APPEND) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_SMV),", does not exist. Set RESTART=.FALSE."
   CALL SHUTDOWN(MESSAGE)
ENDIF
 
IF (APPEND) THEN
   OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   RETURN
ENDIF
 
OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED',STATUS='REPLACE')
 
! Write out TITLE
 
WRITE(LU_SMV,'(A)') 'TITLE'
WRITE(LU_SMV,'(1X,A)')  TRIM(TITLE)

! Indentify as terrain case

IF (TERRAIN_CASE .OR. VEG_LEVEL_SET) THEN
  WRITE(LU_SMV,'(/A)') 'AUTOTERRAIN'
  WRITE(LU_SMV,'(I3)') 1
  WRITE(LU_SMV,'(A)') TRIM(TERRAIN_IMAGE)
ENDIF
 
! Record the version and endian-ness in .smv file
 
WRITE(LU_SMV,'(/A)') 'VERSION'
WRITE(LU_SMV,'(F5.1,2X,A)') VERSION_NUMBER,TRIM(VERSION_STRING)

! Indicate the "endian-ness" of the output files
 
OPEN(LU_END,FILE=FN_END,FORM='UNFORMATTED',STATUS='REPLACE')
WRITE(LU_END) ONE_INTEGER
CLOSE(LU_END)

WRITE(LU_SMV,'(/A)') 'ENDF'
WRITE(LU_SMV,'(1X,A)') TRIM(CHID)//'.end'

! Write out the name of the input file
 
WRITE(LU_SMV,'(/A)') 'INPF'
WRITE(LU_SMV,'(1X,A)') TRIM(FN_INPUT)

!Write out svn revision number
WRITE(LU_SMV,'(/A)') 'REVISION'
WRITE(LU_SMV,'(I6)') SVN_REVISION_NUMBER

! Write out the CHID
WRITE(LU_SMV,'(/A)') 'CHID'
WRITE(LU_SMV,'(1X,A)') TRIM(CHID)

! Number of meshes
 
WRITE(LU_SMV,'(/A)') 'NMESHES'
WRITE(LU_SMV,'(I3)') NMESHES

! Information used for touring in Smokeview
 
WRITE(LU_SMV,'(/A)') 'VIEWTIMES'
WRITE(LU_SMV,'(2F10.2,I6)') 0.0_EB,MAX(0.01_EB,T_END),MAX(2,NFRAMES)
 
! Auxilliary CAD geometry via dxf2fds
 
IF (RENDER_FILE/='null') THEN
   WRITE(LU_SMV,'(/A)') 'CADGEOM'
   WRITE(LU_SMV,'(1X,A)') TRIM(RENDER_FILE)
ENDIF

! Write out smoke albedo
WRITE(LU_SMV,'(/A)') 'ALBEDO'
WRITE(LU_SMV,'(F13.5)') SMOKE_ALBEDO

! Write out info about surfaces

WRITE(LU_SMV,'(/A)') 'SURFDEF'
WRITE(LU_SMV,'(1X,A)') SURFACE(DEFAULT_SURF_INDEX)%ID
 
DO N=0,N_SURF
   SF => SURFACE(N)
   WRITE(LU_SMV,'(/A)') 'SURFACE'
   WRITE(LU_SMV,'(1X,A)') SURFACE(N)%ID
   IF (SF%THERMALLY_THICK) THEN
      ML => MATERIAL(SF%LAYER_MATL_INDEX(1,1))
      WRITE(LU_SMV,'(2F8.2)') TMPM,ML%EMISSIVITY
   ELSE
      WRITE(LU_SMV,'(2F8.2)') 5000.,1.0
   ENDIF
   WRITE(LU_SMV,'(I2,6F13.5)') SF%SURF_TYPE,SF%TEXTURE_WIDTH,SF%TEXTURE_HEIGHT,REAL(SF%RGB,FB)/255._FB,SF%TRANSPARENCY
   WRITE(LU_SMV,'(1X,A)') SF%TEXTURE_MAP
ENDDO
 
! Write out info about particle types

EVAC_ONLY3: IF (.NOT. ALL(EVACUATION_ONLY)) THEN
   DO N=1,N_PART
      PC => PARTICLE_CLASS(N)
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_PARTICLES'
      IF (PC%PROP_ID=='null') THEN
         WRITE(LU_SMV,'(1X,A)')     PC%ID      
      ELSE
         WRITE(LU_SMV,'(1X,A,A,A)') PC%ID,' % % ',TRIM(PC%PROP_ID)
      ENDIF
      WRITE(LU_SMV,'(3F13.5)') REAL(PC%RGB,FB)/255._FB
      WRITE(LU_SMV,'(I3)') PC%N_QUANTITIES
      DO NN=1,PC%N_QUANTITIES
         WRITE(LU_SMV,'(1X,A)') PC%SMOKEVIEW_LABEL(NN)
         WRITE(LU_SMV,'(1X,A)') PC%SMOKEVIEW_BAR_LABEL(NN)
         WRITE(LU_SMV,'(1X,A)') OUTPUT_QUANTITY(PC%QUANTITIES_INDEX(NN))%UNITS
      ENDDO
   ENDDO
ENDIF EVAC_ONLY3

! Write out info about human types for evacuation

EVAC_ONLY4: IF (ANY(EVACUATION_GRID)) THEN
   DO N=1,N_EVAC
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_HUMANS'
      WRITE(LU_SMV,'(1X,A)') TRIM(EVAC_CLASS_NAME(N))
      WRITE(LU_SMV,'(3F13.5)') REAL(EVAC_CLASS_RGB(:,N),FB)/255._EB
      WRITE(LU_SMV,'(I3)') EVAC_N_QUANTITIES
      DO NN=1,EVAC_N_QUANTITIES
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME)
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%SHORT_NAME)
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS)
      ENDDO
   ENDDO
   EVAC_DO1: DO NN=1,EVAC_N_QUANTITIES
      IF(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME=='HUMAN_COLOR') THEN
         WRITE(LU_SMV,'(A)') 'AVATAR_COLOR'
         WRITE(LU_SMV,'(I4)') EVAC_AVATAR_NCOLOR
         DO N=1,EVAC_AVATAR_NCOLOR
            WRITE(LU_SMV,'(3I4)') (EVAC_AVATAR_RGB(I,N),I=1,3)
         ENDDO
         EXIT EVAC_DO1
      ENDIF
   ENDDO EVAC_DO1
   
ENDIF EVAC_ONLY4

! Figure out the outline for multiblock cases
 
PERT1(1) = 0.001_EB 
PERT2(1) = 0.001_EB
PERT1(2) = -.001_EB 
PERT2(2) = 0.001_EB
PERT1(3) = -.001_EB 
PERT2(3) = -.001_EB
PERT1(4) = 0.001_EB 
PERT2(4) = -.001_EB
 
ALLOCATE(XLEVEL(0:2*NMESHES)) 
XLEVEL = -100000._EB
ALLOCATE(YLEVEL(0:2*NMESHES))
YLEVEL = -100000._EB
ALLOCATE(ZLEVEL(0:2*NMESHES)) 
ZLEVEL = -100000._EB
 
NXL = 0 
NYL = 0 
NZL = 0
DO NM=1,2*NMESHES
   XMIN = 100000._EB 
   YMIN = 100000._EB 
   ZMIN = 100000._EB
   DO N=1,2*NMESHES
      M => MESHES(INT((N+1)/2))
      IF (MOD(N,2)/=0) XX = M%XS
      IF (MOD(N,2)==0) XX = M%XF
      IF (MOD(N,2)/=0) YY = M%YS
      IF (MOD(N,2)==0) YY = M%YF
      IF (MOD(N,2)/=0) ZZ = M%ZS
      IF (MOD(N,2)==0) ZZ = M%ZF
      IF (XX>XLEVEL(NXL)) XMIN = MIN(XX,XMIN)
      IF (YY>YLEVEL(NYL)) YMIN = MIN(YY,YMIN)
      IF (ZZ>ZLEVEL(NZL)) ZMIN = MIN(ZZ,ZMIN)
   ENDDO
   IF (XMIN>XLEVEL(NXL)) THEN
      NXL = NXL + 1
      XLEVEL(NXL) = XMIN
   ENDIF
   IF (YMIN>YLEVEL(NYL)) THEN
      NYL = NYL + 1
      YLEVEL(NYL) = YMIN
   ENDIF
   IF (ZMIN>ZLEVEL(NZL)) THEN
      NZL = NZL + 1
      ZLEVEL(NZL) = ZMIN
   ENDIF
ENDDO
 
N_SEGMENTS_MAX = 100
ALLOCATE(SEGMENT(1:N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)
 
N = 0
 
XLOOP1: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   YLOOP1: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((XX<MY%XS .OR. XX>MY%XF) .OR.(YY<MX%YS .OR. YY>MX%YF)) CYCLE YLOOP1
      Z1 = MAX(MX%ZS,MY%ZS)
      Z2 = MIN(MX%ZF,MY%ZF)
      IF (Z1>=Z2) CYCLE YLOOP1
      ZLOOP1: DO NZ=1,NZL
         ZZ = ZLEVEL(NZ)
         IF (ZZ<=Z1) CYCLE ZLOOP1
         IF (ZZ>Z2) CYCLE YLOOP1
         ZA = (Z1+ZZ)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YY+PERT2(I),ZA)) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Z1 = ZZ
            CYCLE ZLOOP1
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (XX==SEG%X1 .AND. XX==SEG%X2 .AND.YY==SEG%Y1 .AND. YY==SEG%Y2 .AND.Z1==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               Z1 = ZZ
               CYCLE ZLOOP1
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX 
         SEG%X2 = XX
         SEG%Y1 = YY 
         SEG%Y2 = YY
         SEG%Z1 = Z1 
         SEG%Z2 = ZZ
         Z1 = ZZ
      ENDDO ZLOOP1
   ENDDO YLOOP1
ENDDO XLOOP1
 
XLOOP2: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   ZLOOP2: DO NZ=1,2*NMESHES
      MZ => MESHES(INT((NZ+1)/2))
      IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
      IF (MOD(NZ,2)==0) ZZ = MZ%ZF
      IF ((XX<MZ%XS .OR. XX>MZ%XF) .OR.(ZZ<MX%ZS .OR. ZZ>MX%ZF)) CYCLE ZLOOP2
      Y1 = MAX(MX%YS,MZ%YS)
      Y2 = MIN(MX%YF,MZ%YF)
      IF (Y1>=Y2) CYCLE ZLOOP2
      YLOOP2: DO NY=1,NYL
         YY = YLEVEL(NY)
         IF (YY<=Y1) CYCLE YLOOP2
         IF (YY>Y2) CYCLE ZLOOP2
         YA = (Y1+YY)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YA,ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Y1 = YY
            CYCLE YLOOP2
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (XX==SEG%X1 .AND. XX==SEG%X2 .AND.Y1==SEG%Y1 .AND. YY==SEG%Y2 .AND.ZZ==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               Y1 = YY
               CYCLE YLOOP2
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX 
         SEG%X2 = XX
         SEG%Y1 = Y1 
         SEG%Y2 = YY
         SEG%Z1 = ZZ 
         SEG%Z2 = ZZ
         Y1 = YY
      ENDDO YLOOP2
   ENDDO ZLOOP2
ENDDO XLOOP2
 
ZLOOP3: DO NZ=1,2*NMESHES
   MZ => MESHES(INT((NZ+1)/2))
   IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
   IF (MOD(NZ,2)==0) ZZ = MZ%ZF
   YLOOP3: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((ZZ<MY%ZS .OR. ZZ>MY%ZF) .OR.(YY<MZ%YS .OR. YY>MZ%YF)) CYCLE YLOOP3
      X1 = MAX(MZ%XS,MY%XS)
      X2 = MIN(MZ%XF,MY%XF)
      IF (X1>=X2) CYCLE YLOOP3
      XLOOP3: DO NX=1,NXL
         XX = XLEVEL(NX)
         IF (XX<=X1) CYCLE XLOOP3
         IF (XX>X2) CYCLE YLOOP3
         XA = (X1+XX)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XA,YY+PERT1(I),ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            X1 = XX
            CYCLE XLOOP3
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (X1==SEG%X1 .AND. XX==SEG%X2 .AND.YY==SEG%Y1 .AND. YY==SEG%Y2 .AND.ZZ==SEG%Z1 .AND. ZZ==SEG%Z2) THEN
               X1 = XX
               CYCLE XLOOP3
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = X1 
         SEG%X2 = XX
         SEG%Y1 = YY 
         SEG%Y2 = YY
         SEG%Z1 = ZZ 
         SEG%Z2 = ZZ
         X1 = XX
      ENDDO XLOOP3
   ENDDO YLOOP3
ENDDO ZLOOP3
 
WRITE(LU_SMV,'(/A)') 'OUTLINE'
WRITE(LU_SMV,'(I4)') N
DO I=1,N
   SEG=>SEGMENT(I)
   WRITE(LU_SMV,'(6F12.4)') SEG%X1,SEG%Y1,SEG%Z1,SEG%X2,SEG%Y2,SEG%Z2
ENDDO
 
DEALLOCATE(SEGMENT)
 
! Spatial offset for texture maps 
 
WRITE(LU_SMV,'(/A)') 'TOFFSET'
WRITE(LU_SMV,'(3F13.5)') (TEX_ORI(I),I=1,3)

! Write out threshold value for HRRPUV

WRITE(LU_SMV,'(/A)') 'HRRPUVCUT'
WRITE(LU_SMV,'(I6)') NMESHES
DO NM=1,NMESHES
   WRITE(LU_SMV,'(F13.5)') MIN(HRRPUVCUT_MAX,20._EB/CHARACTERISTIC_CELL_SIZE)
ENDDO

! Write out RAMP info to .smv file

WRITE(LU_SMV,'(/A)') 'RAMP'
WRITE(LU_SMV,'(I5)') N_RAMP
DO N=1,N_RAMP
   WRITE(LU_SMV,'(1X,A,A)')  'RAMP: ',RAMP_ID(N)
   WRITE(LU_SMV,'(I5)') RAMPS(N)%NUMBER_DATA_POINTS
   DO I=1,RAMPS(N)%NUMBER_DATA_POINTS
      WRITE(LU_SMV,'(6F12.5)') RAMPS(N)%INDEPENDENT_DATA(I),RAMPS(N)%DEPENDENT_DATA(I)
   ENDDO
ENDDO

! Write out PROPerty info to .smv file

DO N=0,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_SMV,'(/A)') 'PROP'
   WRITE(LU_SMV,'(1X,A)') TRIM(PY%ID)
   WRITE(LU_SMV,'(I3)') PY%N_SMOKEVIEW_IDS
   DO NN=1,PY%N_SMOKEVIEW_IDS
      WRITE(LU_SMV,'(1X,A)') TRIM(PY%SMOKEVIEW_ID(NN))
   ENDDO
   WRITE(LU_SMV,'(I3)') PY%N_SMOKEVIEW_PARAMETERS
   DO NN=1,PY%N_SMOKEVIEW_PARAMETERS
      WRITE(LU_SMV,'(1X,A)') PY%SMOKEVIEW_PARAMETERS(NN)
   ENDDO
ENDDO

! Write out DEVICE info to .smv file

DO N=1,N_DEVC
   DV => DEVICE(N)
   PY => PROPERTY(DV%PROP_INDEX)
   WRITE(LU_SMV,'(/A)') 'DEVICE'
   WRITE(LU_SMV,'(1X,A)') TRIM(DV%ID)
   STATE_INDEX = 0
   IF (DV%INITIAL_STATE) STATE_INDEX = 1
   WRITE(LU_SMV,'(6F12.5,2I3,A,A)') DV%X,DV%Y,DV%Z,DV%ORIENTATION(1:3),STATE_INDEX,0,' % ',TRIM(PY%ID)
ENDDO

! Write out TREE info as a series of devices to .smv file

! available information:
!   VEG_FUEL_GEOM(N)  = FUEL_GEOM
!   CROWN_W(N)        = CROWN_WIDTH
!   CROWN_W_BOTTOM(N) = CROWN_WIDTH_BOTTOM
!   CROWN_W_TOP(N)    = CROWN_WIDTH_TOP
!   CROWN_B_H(N)      = CROWN_BASE_HEIGHT
!   TREE_H(N)         = TREE_HEIGHT
!   X_TREE(N) = XYZ(1)
!   Y_TREE(N) = XYZ(2)
!   Z_TREE(N) = XYZ(3)

!DO N=1,N_TREES
!  IF (VEG_FUEL_GEOM(N) == 'CONE' .OR. VEG_FUEL_GEOM(N) == 'CYLINDER') THEN !PROP
!    WRITE(LU_SMV,'(/A)')'PROP'
!    WRITE(LU_SMV,'(1X,A)')TRIM(VEG_LABELS(N))
!    WRITE(LU_SMV,'(2X,I1)') 1
!    IF (VEG_FUEL_GEOM(N) == 'CONE') VEG_DEVICE = 'canopy'
!    IF (VEG_FUEL_GEOM(N) == 'CYLINDER') VEG_DEVICE = 'trunk'
!    WRITE(LU_SMV,'(1X,A)')TRIM(VEG_DEVICE)
!    WRITE(LU_SMV,'(2X,I1)') 6
!!   WRITE(TCFORM,'(F8.2)') CROWN_B_H(N) ; WRITE(TCFORM,'(A,A)')'CANOPY_BASE_H=',TRIM(TCFORM)
!!   WRITE(LU_SMV,'(1X,A)')TRIM(TCFORM)
!!   WRITE(TCFORM,'(F8.2)') CROWN_W(N) ; WRITE(TCFORM,'(A,A)')'CANOPY_D=',TRIM(TCFORM)
!!   WRITE(LU_SMV,'(1X,A)')TRIM(TCFORM)
!!   WRITE(TCFORM,'(F8.2)') TREE_H(N)-CROWN_B_H(N) ; WRITE(TCFORM,'(A,A)')'CANOPY_H=',TRIM(TCFORM)
!!   WRITE(LU_SMV,'(1X,A)')TRIM(TCFORM)
!    WRITE(LU_SMV,'(1X,A)') 'CANOPY_BASE_H=0.3'
!    WRITE(LU_SMV,'(1X,A)') 'CANOPY_D=1.0'
!    WRITE(LU_SMV,'(1X,A)') 'CANOPY_H=3.7'
!    WRITE(LU_SMV,'(1X,A)') 'R=25'
!    WRITE(LU_SMV,'(1X,A)') 'G=108'
!    WRITE(LU_SMV,'(1X,A)') 'B=0'
!  ENDIF
!ENDDO

DO N=1,N_TREES
   IF (VEG_FUEL_GEOM(N) == 'CONE' .OR. VEG_FUEL_GEOM(N) == 'CYLINDER') THEN
      IF (VEG_FUEL_GEOM(N) == 'CONE') VEG_DEVICE = 'CANOPY'
      IF (VEG_FUEL_GEOM(N) == 'CYLINDER') VEG_DEVICE = 'TRUNK'
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(1X,A)') TRIM(VEG_DEVICE)
      WRITE(LU_SMV,'(6F12.5,1X,I3,1X,I5,1X,"%",(A))') X_TREE(N), Y_TREE(N), Z_TREE(N),0.0,0.0, 1.0,0,3,TRIM(VEG_LABELS(N))
      CROWN_HEIGHT = TREE_H(N)-CROWN_B_H(N)
      WRITE(LU_SMV,'(3F12.5)') CROWN_B_H(N), CROWN_W(N), CROWN_HEIGHT
   ENDIF
ENDDO

! Write out level set slice file name (placeholder)
IF (VEG_LEVEL_SET) THEN
   WRITE(LU_SMV,'(A,5X,2I3)') 'SLCT ',1,1 !terrain slice assumes one mesh and puts level set data on terrain
   WRITE(LU_SMV,'(A)') 'lsfs.sf'
   WRITE(LU_SMV,'(A)') 'phifield'
   WRITE(LU_SMV,'(A)') 'phifield'
   WRITE(LU_SMV,'(A)') '-'
ENDIF 

! Write out GEOMETRY info (experimental)

DO N=1,N_GEOM
   G => GEOMETRY(N)
   WRITE(LU_SMV,'(/A)') 'PROP'
   WRITE(LU_SMV,'(1X,A)') G%ID
   WRITE(LU_SMV,'(1X,I3)') 1
   WRITE(LU_SMV,'(1X,A)') G%SMVOBJECT
   WRITE(LU_SMV,'(1X,I3)') 12
   WRITE(LU_SMV,'(1X,A,I3)') 'R=',G%RGB(1)
   WRITE(LU_SMV,'(1X,A,I3)') 'G=',G%RGB(2)
   WRITE(LU_SMV,'(1X,A,I3)') 'B=',G%RGB(3)
   
   ! find rotation matrix
   VOR = (/G%XOR,G%YOR,G%ZOR/)
   VOR_DEFAULT = (/0._EB,0._EB,1._EB/)
   THETA = ACOS(DOT_PRODUCT(VOR_DEFAULT,VOR))
   
   IF (ABS(THETA)>1.E-6_EB) THEN
      CALL CROSS_PRODUCT(UU,VOR_DEFAULT,VOR)
      UU = UU/NORM2(UU)
         
      ! projection onto axis of rotation
      PP(1,1) = UU(1)**2
      PP(1,2) = UU(1)*UU(2)
      PP(1,3) = UU(1)*UU(3)
   
      PP(2,1) = UU(1)*UU(2)
      PP(2,2) = UU(2)**2
      PP(2,3) = UU(2)*UU(3)
   
      PP(3,1) = UU(1)*UU(3)
      PP(3,2) = UU(2)*UU(3)
      PP(3,3) = UU(3)**2
   
      ! identity matrix
      EYE(1,1) = 1._EB
      EYE(2,2) = 1._EB
      EYE(3,3) = 1._EB
   
      ! skew-symmetric representation
      QQ(1,2) = -UU(3)
      QQ(1,3) = UU(2)
      QQ(2,1) = UU(3)
      QQ(2,3) = -UU(1)
      QQ(3,1) = -UU(2)
      QQ(3,2) = UU(1)
   
      RR = PP + (EYE-PP)*COS(THETA) + QQ*SIN(THETA)
   ELSE
      ! identity matrix
      RR(1,1) = 1._EB
      RR(2,2) = 1._EB
      RR(3,3) = 1._EB
   ENDIF
   
   WRITE(LU_SMV,'(1X A,1F12.5)') 'VX=', RR(1,1)*G%U0 + RR(2,1)*G%V0 + RR(3,1)*G%W0
   WRITE(LU_SMV,'(1X A,1F12.5)') 'VY=', RR(1,2)*G%U0 + RR(2,2)*G%V0 + RR(3,2)*G%W0
   WRITE(LU_SMV,'(1X A,1F12.5)') 'VZ=', RR(1,3)*G%U0 + RR(2,3)*G%V0 + RR(3,3)*G%W0
   WRITE(LU_SMV,'(1X A,1F12.5)') 'ROTATE_RATE=',G%OMEGA*180._EB/PI
   WRITE(LU_SMV,'(1X A,1F12.5)') 'D=',2._EB*G%RADIUS
   WRITE(LU_SMV,'(1X A,1F12.5)') 'XMAX=',G%X+G%RADIUS
   WRITE(LU_SMV,'(1X A,1F12.5)') 'YMAX=',G%Y+G%RADIUS
   WRITE(LU_SMV,'(1X A,1F12.5)') 'ZMAX=',G%Z+G%RADIUS
   WRITE(LU_SMV,'(1X 3A)') 'tfile="t%',TRIM(G%TFILE),'"'
   
   WRITE(LU_SMV,'(/A)') 'DEVICE'
   !SELECT CASE(G%ISHAPE)
      !CASE(ISPHERE)
         WRITE(LU_SMV,'(1X A)') 'geom'
         WRITE(LU_SMV,'(6F12.5,2I3,2A)') G%X,G%Y,G%Z,G%XOR,G%YOR,G%ZOR,0,0,' % ',G%ID
      !CASE(ICYLINDER)
      !   WRITE(LU_SMV,'(A)') 'geom'
      !   WRITE(LU_SMV,'(6F12.5,2I5)') G%X,G%Y,G%Z,0._EB,0._EB,1._EB,0,7
      !   WRITE(LU_SMV,'(5F12.5,I5)') REAL(G%RGB,EB)/255._EB,2._EB*G%RADIUS,2._EB*G%HL(2),-90
      !   WRITE(LU_SMV,'(F12.5)') 0._EB
      !CASE(IPLANE)
      !   WRITE(LU_SMV,'(A)') 'plane'
      !   WRITE(LU_SMV,'(6F12.5,2I5)') G%X,G%Y,G%Z,(/G%XOR-G%X,G%YOR-G%Y,G%ZOR-G%Z/),0,4
      !   WRITE(LU_SMV,'(4F12.5)') REAL(G%RGB,EB)/255._EB,G%PIXELS
      !CASE DEFAULT
      !   WRITE(LU_SMV,'(A)') G%SHAPE
      !   WRITE(LU_SMV,'(6F12.5,2I5)') G%X,G%Y,G%Z,(/G%XOR-G%X,G%YOR-G%Y,G%ZOR-G%Z/),0,4
      !   WRITE(LU_SMV,'(4F12.5)') REAL(G%RGB,EB)/255._EB,2._EB*G%RADIUS
   
   !END SELECT
ENDDO

ENDIF MASTER_NODE_IF

! Write out EVACUATION DEVICE info to .smv file (EXIT/DOOR/ENTR/EVSS)

EVAC_ONLY5: IF (ANY(EVACUATION_GRID).AND.MYID==MAX(0,EVAC_PROCESS)) THEN
   DO N=1,N_DOORS
      IF (.NOT.EVAC_DOORS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_DOORS(N)%X1+EVAC_DOORS(N)%X2)
      YY = 0.5_EB*(EVAC_DOORS(N)%Y1+EVAC_DOORS(N)%Y2)
      ZZ = EVAC_DOORS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacdoor'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_DOORS(N)%ORIENTATION(1:3),0,9
      ! WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_DOORS(N)%WIDTH, 0.05, EVAC_DOORS(N)%HEIGHT, EVAC_DOORS(N)%RGB(1:3)
      ! x y z translate for the arrow (cone)
      ! xx: upwards, yy: right, zz: towards the door
      IF (ABS(EVAC_DOORS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_DOORS(N)%WIDTH, 0.05, EVAC_DOORS(N)%HEIGHT, EVAC_DOORS(N)%RGB(1:3)
         ZZ = (EVAC_DOORS(N)%Y - YY)
         YY = -EVAC_DOORS(N)%IOR*(EVAC_DOORS(N)%X - XX)
         XX = ZZ
         ZZ = 0.5_EB*EVAC_DOORS(N)%IOR*EVAC_DOORS(N)%HEIGHT
      ELSE
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_DOORS(N)%HEIGHT, 0.05, EVAC_DOORS(N)%WIDTH, EVAC_DOORS(N)%RGB(1:3)
         YY = -EVAC_DOORS(N)%IOR*(EVAC_DOORS(N)%Y - YY)/2.0_EB
         ZZ = (EVAC_DOORS(N)%X - XX)
         XX = 0.25_EB*EVAC_DOORS(N)%IOR*EVAC_DOORS(N)%HEIGHT
      ENDIF
      WRITE(LU_SMV,'(3F10.3)') ZZ, XX, YY
   ENDDO
   DO N=1,N_EXITS
      IF (EVAC_EXITS(N)%COUNT_ONLY .OR. .NOT.EVAC_EXITS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_EXITS(N)%X1+EVAC_EXITS(N)%X2)
      YY = 0.5_EB*(EVAC_EXITS(N)%Y1+EVAC_EXITS(N)%Y2)
      ZZ = EVAC_EXITS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacdoor'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_EXITS(N)%ORIENTATION(1:3),0,9
      ! WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_EXITS(N)%WIDTH, 0.05, EVAC_EXITS(N)%HEIGHT, EVAC_EXITS(N)%RGB(1:3)
      ! x y z translate for the arrow (cone)
      ! xx: upwards, yy: right, zz: towards the door
      IF (ABS(EVAC_EXITS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_EXITS(N)%WIDTH, 0.05, EVAC_EXITS(N)%HEIGHT, EVAC_EXITS(N)%RGB(1:3)
         ZZ = (EVAC_EXITS(N)%Y - YY)
         YY = -EVAC_EXITS(N)%IOR*(EVAC_EXITS(N)%X - XX)
         XX = ZZ
         ZZ = 0.5_EB*EVAC_EXITS(N)%IOR*EVAC_EXITS(N)%HEIGHT
      ELSE
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_EXITS(N)%HEIGHT, 0.05, EVAC_EXITS(N)%WIDTH, EVAC_EXITS(N)%RGB(1:3)
         YY = -EVAC_EXITS(N)%IOR*(EVAC_EXITS(N)%Y - YY)/2.0_EB
         ZZ = (EVAC_EXITS(N)%X - XX)
         XX = 0.25_EB*EVAC_EXITS(N)%IOR*EVAC_EXITS(N)%HEIGHT
      ENDIF
      WRITE(LU_SMV,'(3F10.3)') ZZ, XX, YY
   ENDDO
   DO N=1,N_ENTRYS
      IF (.NOT.EVAC_ENTRYS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_ENTRYS(N)%X1+EVAC_ENTRYS(N)%X2)
      YY = 0.5_EB*(EVAC_ENTRYS(N)%Y1+EVAC_ENTRYS(N)%Y2)
      ZZ = EVAC_ENTRYS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacentr'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_ENTRYS(N)%ORIENTATION(1:3),0,6
      IF (ABS(EVAC_ENTRYS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_ENTRYS(N)%WIDTH, 0.05, EVAC_ENTRYS(N)%HEIGHT, EVAC_ENTRYS(N)%RGB(1:3)
      ELSE
         WRITE(LU_SMV,'(3F10.3,3I6)') EVAC_ENTRYS(N)%HEIGHT, 0.05, EVAC_ENTRYS(N)%WIDTH, EVAC_ENTRYS(N)%RGB(1:3)
      ENDIF
   ENDDO
   DO N=1,N_SSTANDS
      IF (.NOT.EVAC_SSTANDS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_SSTANDS(N)%X1+EVAC_SSTANDS(N)%X2)
      YY = 0.5_EB*(EVAC_SSTANDS(N)%Y1+EVAC_SSTANDS(N)%Y2)
      ZZ = 0.5_EB*(EVAC_SSTANDS(N)%Z1+EVAC_SSTANDS(N)%Z2+EVAC_SSTANDS(N)%H+EVAC_SSTANDS(N)%H0) - &
           EVACUATION_Z_OFFSET(EVAC_SSTANDS(N)%IMESH)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacincline'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,EVAC_SSTANDS(N)%ORIENTATION(1:3),0,6
      IF (ABS(EVAC_SSTANDS(N)%IOR) <= 1) THEN
         YY = ABS(EVAC_SSTANDS(N)%X2-EVAC_SSTANDS(N)%X1)/EVAC_SSTANDS(N)%COS_X
         XX = ABS(EVAC_SSTANDS(N)%Y2-EVAC_SSTANDS(N)%Y1)
      ELSE
         YY = ABS(EVAC_SSTANDS(N)%X2-EVAC_SSTANDS(N)%X1)
         XX = ABS(EVAC_SSTANDS(N)%Y2-EVAC_SSTANDS(N)%Y1)/EVAC_SSTANDS(N)%COS_Y
      ENDIF
      WRITE(LU_SMV,'(3F10.3,3I6)') XX, 0.1, YY, EVAC_SSTANDS(N)%RGB(1:3)
   ENDDO
   NN = 0
   DO N=1,NPC_EVAC
      IF (.NOT.EVACUATION(N)%SHOW) CYCLE
      NN = NN + 1
      XX = EVACUATION(N)%X1
      YY = EVACUATION(N)%Y1
      ZZ = 0.5_EB*(EVACUATION(N)%Z1+EVACUATION(N)%Z2)+0.05_EB*(NN-1)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacbox'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,0.0,0.0,1.0,0,6
      XX = ABS(EVACUATION(N)%X1-EVACUATION(N)%X2)
      YY = ABS(EVACUATION(N)%Y1-EVACUATION(N)%Y2)
      WRITE(LU_SMV,'(3I6,3F10.3)')  EVACUATION(N)%RGB(1:3), XX, YY, 0.05
   ENDDO
   NN = 0
   DO N=1,N_HOLES
      IF (.NOT.EVAC_HOLES(N)%SHOW) CYCLE
      NN = NN + 1
      XX = EVAC_HOLES(N)%X1
      YY = EVAC_HOLES(N)%Y1
      ZZ = 0.5_EB*(EVAC_HOLES(N)%Z1+EVAC_HOLES(N)%Z2)+0.05_EB*(NN-1)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacbox'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,0.0,0.0,1.0,0,6
      XX = ABS(EVAC_HOLES(N)%X1-EVAC_HOLES(N)%X2)
      YY = ABS(EVAC_HOLES(N)%Y1-EVAC_HOLES(N)%Y2)
      WRITE(LU_SMV,'(3I6,3F10.3)')  EVAC_HOLES(N)%RGB(1:3), XX, YY, 0.05
   ENDDO
END IF EVAC_ONLY5
 
! Write grid info for each block
 
MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID) CYCLE

   M => MESHES(NM)
   T => TRANS(NM)
 
   WRITE(LU_SMV,'(/A)') 'OFFSET'
   WRITE(LU_SMV,'(3F13.5)') 0.,0.,0.

   WRITE(LU_SMV,'(/A,3X,A)') 'GRID',TRIM(MESH_NAME(NM))
   IF (.NOT.EVACUATION_ONLY(NM)) EVAC_CODE=0
   IF (     EVACUATION_ONLY(NM)) EVAC_CODE=2
   IF (     EVACUATION_GRID(NM)) EVAC_CODE=1
   WRITE(LU_SMV,'(4I5)') M%IBAR,M%JBAR,M%KBAR,EVAC_CODE

   WRITE(LU_SMV,'(/A)') 'PDIM'
   WRITE(LU_SMV,'(9F13.5)') M%XS,M%XF,M%YS,M%YF,M%ZS,M%ZF,(REAL(M%RGB(I),FB)/255._FB,I = 1,3)

   WRITE(LU_SMV,'(/A)') 'TRNX'
   WRITE(LU_SMV,'(I5)') T%NOC(1)
   DO N=1,T%NOC(1)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,1),T%CCSTORE(N,1),T%PCSTORE(N,1)
   ENDDO
   DO I=0,M%IBAR
      WRITE(LU_SMV,'(I5,F12.5)') I,M%X(I)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNY'
   WRITE(LU_SMV,'(I5)') T%NOC(2)
   DO N=1,T%NOC(2)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,2),T%CCSTORE(N,2),T%PCSTORE(N,2)
   ENDDO
   DO J=0,M%JBAR
      WRITE(LU_SMV,'(I5,F12.5)') J,M%Y(J)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNZ'
   WRITE(LU_SMV,'(I5)') T%NOC(3)
   DO N=1,T%NOC(3)
      WRITE(LU_SMV,'(I5,2F12.5)') T%IDERIVSTORE(N,3),T%CCSTORE(N,3),T%PCSTORE(N,3)
   ENDDO
   DO K=0,M%KBAR
      WRITE(LU_SMV,'(I5,F12.5)') K,M%Z(K)
   ENDDO
 
   ! Write obstacle info to .smv file
 
   WRITE(LU_SMV,'(/A)') 'OBST'
   WRITE(LU_SMV,*) M%N_OBST
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF(OB%PROP_ID=='null')THEN
         TEMPCHAR=' '
      ELSE
         TEMPCHAR=' % '//OB%PROP_ID
      ENDIF
      IF (OB%TEXTURE(1)==-999._EB) THEN
         WRITE(LU_SMV,'(6F12.5,I7,6I4,1X,A33)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
                                    OB%IBC(-1),OB%IBC(1),OB%IBC(-2),OB%IBC(2),OB%IBC(-3),OB%IBC(3), &
                                    TEMPCHAR
      ELSE
         WRITE(LU_SMV,'(6F12.5,I7,6I4,3F13.5,1X,A33)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%IBC(-1),OB%IBC(1),OB%IBC(-2),OB%IBC(2),OB%IBC(-3),OB%IBC(3), OB%TEXTURE(1),OB%TEXTURE(2),OB%TEXTURE(3),&
            TEMPCHAR
      ENDIF
   ENDDO
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%COLOR_INDICATOR/=-3) THEN
         WRITE(LU_SMV,'(8I5)')        OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,OB%TYPE_INDICATOR
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,OB%TYPE_INDICATOR, &
                                      REAL(OB%RGB,FB)/255._FB, OB%TRANSPARENCY
      ENDIF
   ENDDO
 
   ! Replace vents on exterior mesh boundary with "dummy" vents to avoid overlap conflict in Smokeview

   NDV = 0
   NDVDIM = 1000
   ALLOCATE(DUMMY_VENT_INDEX(NDVDIM))
   ALLOCATE(IDV1(NDVDIM))
   ALLOCATE(IDV2(NDVDIM))
   ALLOCATE(JDV1(NDVDIM))
   ALLOCATE(JDV2(NDVDIM))
   ALLOCATE(KDV1(NDVDIM))
   ALLOCATE(KDV2(NDVDIM))
   ALLOCATE(VENT_INDICES(MAX(M%IBAR,M%JBAR),MAX(M%JBAR,M%KBAR),6))

   VENT_INDICES = 0

   VENT_LOOP: DO N=1,M%N_VENT

      VT=>M%VENTS(N)

      FACE_INDEX = 0
      IF (VT%I1==0      .AND. VT%I2==0     ) FACE_INDEX = 1
      IF (VT%I1==M%IBAR .AND. VT%I2==M%IBAR) FACE_INDEX = 2
      IF (VT%J1==0      .AND. VT%J2==0     ) FACE_INDEX = 3
      IF (VT%J1==M%JBAR .AND. VT%J2==M%JBAR) FACE_INDEX = 4
      IF (VT%K1==0      .AND. VT%K2==0     ) FACE_INDEX = 5
      IF (VT%K1==M%KBAR .AND. VT%K2==M%KBAR) FACE_INDEX = 6

      SELECT CASE(FACE_INDEX)  ! Get vent cell indices
         CASE(0)
            CYCLE VENT_LOOP
         CASE(1:2)
            HI1 = VT%J1+1
            HI2 = VT%J2
            VI1 = VT%K1+1
            VI2 = VT%K2
         CASE(3:4)
            HI1 = VT%I1+1
            HI2 = VT%I2
            VI1 = VT%K1+1
            VI2 = VT%K2
         CASE(5:6)
            HI1 = VT%I1+1
            HI2 = VT%I2
            VI1 = VT%J1+1
            VI2 = VT%J2
      END SELECT

      IF (VT%BOUNDARY_TYPE==MIRROR_BOUNDARY .OR. VT%BOUNDARY_TYPE==OPEN_BOUNDARY) THEN
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = -1
      ELSE  ! Make solid color vents invisible (they will be replaced by dummy vents)
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = N
         VT%COLOR_INDICATOR =  8
         VT%TYPE_INDICATOR  = -2
         VT%TRANSPARENCY    =  0._EB
      ENDIF

   ENDDO VENT_LOOP

   ! Look for interpolated meshes and ensure that dummy vents are not drawn there

   DO K=1,M%KBAR
      J_LOOP1: DO J=1,M%JBAR
!         DO N=1,M%N_OBST
!            OB => M%OBSTRUCTION(N)
!            IF ((OB%I1==0.OR.OB%I2==M%IBAR) .AND. (OB%J1<J.AND.J<=OB%J2) .AND. (OB%K1<K.AND.K<=OB%K2)) CYCLE J_LOOP1
!         ENDDO
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         XX = M%X(0) - 0.001_EB*M%DX(0)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(J,K,1) = -1
         XX = M%X(M%IBAR) + 0.001_EB*M%DX(M%IBAR)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(J,K,2) = -1
      ENDDO J_LOOP1
   ENDDO

   DO K=1,M%KBAR
      I_LOOP1: DO I=1,M%IBAR
!         DO N=1,M%N_OBST
!            OB => M%OBSTRUCTION(N)
!            IF ((OB%J1==0) .AND. (OB%I1<I.AND.I<=OB%I2) .AND. (OB%K1<K.AND.K<=OB%K2)) CYCLE I_LOOP1
!         ENDDO
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         YY = M%Y(0) - 0.001_EB*M%DY(0)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(I,K,3) = -1
         YY = M%Y(M%JBAR) + 0.001_EB*M%DY(M%JBAR)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(I,K,4) = -1
      ENDDO I_LOOP1
   ENDDO

   DO J=1,M%JBAR
      I_LOOP2: DO I=1,M%IBAR
!         DO N=1,M%N_OBST
!            OB => M%OBSTRUCTION(N)
!            IF ((OB%K1==0.OR.OB%K2==M%KBAR) .AND. (OB%I1<I.AND.I<=OB%I2) .AND. (OB%J1<J.AND.J<=OB%J2)) CYCLE I_LOOP2
!         ENDDO
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = M%Z(0) - 0.001_EB*M%DZ(0)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(I,J,5) = -1
         ZZ = M%Z(M%KBAR) + 0.001_EB*M%DZ(M%KBAR)
         IF (INTERIOR(XX,YY,ZZ)) VENT_INDICES(I,J,6) = -1
      ENDDO I_LOOP2
   ENDDO

   ! Create dummy vents to fill in areas around actual specified vents

   CALL DUMMY_VENTS(1,M%JBAR,M%KBAR,JDV1,JDV2,KDV1,KDV2,0     ,IDV1,IDV2)
   CALL DUMMY_VENTS(2,M%JBAR,M%KBAR,JDV1,JDV2,KDV1,KDV2,M%IBAR,IDV1,IDV2)
   CALL DUMMY_VENTS(3,M%IBAR,M%KBAR,IDV1,IDV2,KDV1,KDV2,0     ,JDV1,JDV2)
   CALL DUMMY_VENTS(4,M%IBAR,M%KBAR,IDV1,IDV2,KDV1,KDV2,M%JBAR,JDV1,JDV2)
   CALL DUMMY_VENTS(5,M%IBAR,M%JBAR,IDV1,IDV2,JDV1,JDV2,0     ,KDV1,KDV2)
   CALL DUMMY_VENTS(6,M%IBAR,M%JBAR,IDV1,IDV2,JDV1,JDV2,M%KBAR,KDV1,KDV2)

   DEALLOCATE(VENT_INDICES)

   ! Write out information about vents to Smokeview file

   WRITE(LU_SMV,'(/A)') 'VENT'
   WRITE(LU_SMV,'(2I5)') M%N_VENT+NDV,NDV

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%TEXTURE(1)==-999._EB) THEN
         WRITE(LU_SMV,'(6F12.5,I6,I4)')        VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%IBC
      ELSE
         WRITE(LU_SMV,'(6F12.5,I6,I4,3F13.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%IBC, &
                                               VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3)
      ENDIF
   ENDDO

   DO N=1,NDV
      IBC = DEFAULT_SURF_INDEX
      IF (DUMMY_VENT_INDEX(N)>0) IBC=M%VENTS(DUMMY_VENT_INDEX(N))%IBC
      WRITE(LU_SMV,'(6F12.5,I6,I4)') M%X(IDV1(N)),M%X(IDV2(N)),M%Y(JDV1(N)),M%Y(JDV2(N)),  &
                                     M%Z(KDV1(N)),M%Z(KDV2(N)),M%N_VENT+N,IBC
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) COLOR_INDEX = -VT%COLOR_INDICATOR
      IF (VT%BOUNDARY_TYPE/=OPEN_BOUNDARY) COLOR_INDEX =  VT%COLOR_INDICATOR
      IF (VT%RGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)')        VT%I1,VT%I2,VT%J1,VT%J2,VT%K1,VT%K2,COLOR_INDEX,VT%TYPE_INDICATOR
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') VT%I1,VT%I2,VT%J1,VT%J2,VT%K1,VT%K2,COLOR_INDEX,VT%TYPE_INDICATOR, &
                                      REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY
      ENDIF
   ENDDO
   DO N=1,NDV
      COLOR_INDEX = 99
      TYPE_INDEX  = 0
      VRGB        = -1
      IF (DUMMY_VENT_INDEX(N)>0) VRGB = M%VENTS(DUMMY_VENT_INDEX(N))%RGB
      IF (VRGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)') IDV1(N),IDV2(N),JDV1(N),JDV2(N),KDV1(N),KDV2(N),COLOR_INDEX,TYPE_INDEX
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') IDV1(N),IDV2(N),JDV1(N),JDV2(N),KDV1(N),KDV2(N),COLOR_INDEX,TYPE_INDEX, &
                                      REAL(VRGB,FB)/255._FB,1._EB
      ENDIF
   ENDDO

   DEALLOCATE(IDV1)
   DEALLOCATE(IDV2)
   DEALLOCATE(JDV1)
   DEALLOCATE(JDV2)
   DEALLOCATE(KDV1)
   DEALLOCATE(KDV2)
   DEALLOCATE(DUMMY_VENT_INDEX)

ENDDO MESH_LOOP

! Flush the .smv file

CLOSE(LU_SMV)


CONTAINS


SUBROUTINE DUMMY_VENTS(FI,N1,N2,IVV1,IVV2,JVV1,JVV2,N3,KVV1,KVV2)

! For exterior mesh face, FI, create "dummy" vent patches for Smokeview 

INTEGER, INTENT(IN) :: N1,N2,N3,FI
INTEGER, INTENT(INOUT), DIMENSION(NDVDIM) :: IVV1,IVV2,JVV1,JVV2,KVV1,KVV2
INTEGER :: I,J,II,JJ,ISTP,JSTP,VENT_INDEX

JLOOP: DO J=1,N2
   ILOOP: DO I=1,N1

      IF (VENT_INDICES(I,J,FI)==-1) CYCLE ILOOP
      VENT_INDEX = VENT_INDICES(I,J,FI)

      ISTP = N1 
      JSTP = N2
      JJLOOP: DO JJ=J+1,N2
         IF (VENT_INDICES(I,JJ,FI)/=VENT_INDEX) THEN
            JSTP = JJ-1
            EXIT JJLOOP
         ENDIF
      ENDDO JJLOOP

      IILOOP: DO II=I+1,N1
         JJLOOP2: DO JJ=J,JSTP
         IF (VENT_INDICES(II,JJ,FI)/=VENT_INDEX) THEN
            ISTP = II-1
            EXIT IILOOP
         ENDIF
         ENDDO JJLOOP2
      ENDDO IILOOP

      NDV = NDV + 1
      VENT_INDICES(I:ISTP,J:JSTP,FI) = -1 
      IVV1(NDV) = I-1
      IVV2(NDV) = ISTP
      JVV1(NDV) = J-1
      JVV2(NDV) = JSTP
      KVV1(NDV) = N3
      KVV2(NDV) = N3
      DUMMY_VENT_INDEX(NDV) = VENT_INDEX

   ENDDO ILOOP
ENDDO JLOOP

END SUBROUTINE DUMMY_VENTS


SUBROUTINE TRIM_LABEL(T,LAB)

CHARACTER(30), INTENT(OUT) :: LAB
REAL(EB), INTENT(IN) :: T

IF (T<  .00_EB   .AND. T>=  -.001_EB) WRITE(LAB,'(F4.1)') T
IF (T<   .001_EB .AND. T>=    -.1_EB) WRITE(LAB,'(F6.3)') T
IF (T<    -.1_EB .AND. T>=    -1._EB) WRITE(LAB,'(F5.2)') T
IF (T<    -1._EB .AND. T>=   -10._EB) WRITE(LAB,'(F5.1)') T
IF (T<   -10._EB .AND. T>=  -100._EB) WRITE(LAB,'(F5.0)') T
IF (T<  -100._EB .AND. T>= -1000._EB) WRITE(LAB,'(F6.0)') T
IF (T< -1000._EB .AND. T>=-10000._EB) WRITE(LAB,'(F7.0)') T
IF (T<-10000._EB                   ) WRITE(LAB,'(F8.0)') T

IF (T>=  .00_EB  .AND. T<  .001_EB) WRITE(LAB,'(F4.1)') T
IF (T>=  .001_EB .AND. T<    .1_EB) WRITE(LAB,'(F6.3)') T
IF (T>=    .1_EB .AND. T<    1._EB) WRITE(LAB,'(F5.2)') T
IF (T>=    1._EB .AND. T<   10._EB) WRITE(LAB,'(F4.1)') T
IF (T>=   10._EB .AND. T<  100._EB) WRITE(LAB,'(F4.1)') T
IF (T>=  100._EB .AND. T< 1000._EB) WRITE(LAB,'(F4.0)') T
IF (T>= 1000._EB .AND. T<10000._EB) WRITE(LAB,'(F5.0)') T
IF (T>=10000._EB                  ) WRITE(LAB,'(F6.0)') T

END SUBROUTINE TRIM_LABEL


SUBROUTINE RE_ALLOCATE_SEGMENTS
USE MEMORY_FUNCTIONS, ONLY : ChkMemErr
TYPE(SEGMENT_TYPE), ALLOCATABLE, DIMENSION(:) :: DUMMY_SEGMENT
INTEGER :: IZERO

ALLOCATE(DUMMY_SEGMENT(N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','DUMMY_SEGMENT',IZERO)
DUMMY_SEGMENT(1:N_SEGMENTS_MAX) = SEGMENT(1:N_SEGMENTS_MAX)

DEALLOCATE(SEGMENT)
ALLOCATE(SEGMENT(N_SEGMENTS_MAX+100),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)
SEGMENT(1:N_SEGMENTS_MAX) = DUMMY_SEGMENT(1:N_SEGMENTS_MAX)
N_SEGMENTS_MAX = N_SEGMENTS_MAX + 100

DEALLOCATE(DUMMY_SEGMENT)

END SUBROUTINE RE_ALLOCATE_SEGMENTS


END SUBROUTINE WRITE_SMOKEVIEW_FILE


SUBROUTINE WRITE_STATUS_FILES

! Status files are used to indicate how FDS ended

IF (STATUS_FILES) THEN
   OPEN(LU_NOTREADY,FILE=FN_NOTREADY,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU_NOTREADY,'(A ,A/)') ' Job ID string: ', TRIM(CHID)
ENDIF

END SUBROUTINE WRITE_STATUS_FILES


SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE
USE RADCONS, ONLY: NRT,RSA,NRP,TIME_STEP_INCREMENT,ANGLE_INCREMENT,PATH_LENGTH
USE MATH_FUNCTIONS, ONLY : EVALUATE_RAMP 
INTEGER :: NM,I,NN,N,NR,NL,NS
REAL(EB) SD
CHARACTER(30) :: QUANTITY
 
! Write out preliminary stuff to error file (unit 0)
 
WRITE(LU_ERR,'(/A/)')      ' Fire Dynamics Simulator'
WRITE(LU_ERR,'(A,A)')      ' Compilation Date : ',TRIM(COMPILE_DATE)
IF (.NOT.USE_MPI .AND. .NOT.USE_OPENMP) WRITE(LU_ERR,'(/A,A,A)')" Version: ",TRIM(VERSION_STRING),"; MPI Disabled; OpenMP Disabled"
IF (     USE_MPI .AND. .NOT.USE_OPENMP) WRITE(LU_ERR,'(/A,A,A)')" Version: ",TRIM(VERSION_STRING),"; MPI Enabled; OpenMP Disabled"
IF (.NOT.USE_MPI .AND.      USE_OPENMP) WRITE(LU_ERR,'(/A,A,A)')" Version: ",TRIM(VERSION_STRING),"; MPI Disabled; OpenMP Enabled"
IF (     USE_MPI .AND.      USE_OPENMP) WRITE(LU_ERR,'(/A,A,A)')" Version: ",TRIM(VERSION_STRING),"; MPI Enabled; OpenMP Enabled"
IF (USE_OPENMP .AND. .NOT.USE_MPI) WRITE(LU_ERR,'(A,I3/)')           ' Number of available threads: ',OPENMP_AVAILABLE_THREADS
WRITE(LU_ERR,'(A,I4/)')    ' SVN Revision No. : ',SVN_REVISION_NUMBER
WRITE(LU_ERR,'(A,A)')      ' Job TITLE        : ',TRIM(TITLE)
WRITE(LU_ERR,'(A,A/)')     ' Job ID string    : ',TRIM(CHID)
 
! Write out the input parameters to output file (unit 6)
 
WRITE(LU_OUTPUT,'(/A/)')      ' Fire Dynamics Simulator'
WRITE(LU_OUTPUT,'(A,A)')      ' Compilation Date : ',TRIM(COMPILE_DATE)
IF (.NOT.USE_MPI)   WRITE(LU_OUTPUT,'(A,A,A)')      ' Version          : ',TRIM(VERSION_STRING),' Serial'
IF (USE_MPI)        WRITE(LU_OUTPUT,'(A,A,A)')      ' Version          : ',TRIM(VERSION_STRING),' Parallel'

! ADD Version and OpenMP Information

IF (.NOT. USE_OPENMP) WRITE (LU_OUTPUT,'(/A/)')      ' OpenMP Disabled'
IF (USE_OPENMP) WRITE(LU_OUTPUT,'(/A/)')             ' OpenMP Enabled'
IF (USE_OPENMP) WRITE(LU_OUTPUT,'(A,I3/)')           ' Number of OpenMP threads: ',OPENMP_AVAILABLE_THREADS

WRITE(LU_OUTPUT,'(A,I4/)')    ' SVN Revision No. : ',SVN_REVISION_NUMBER
WRITE(LU_OUTPUT,'(A,A)')      ' Job TITLE        : ',TRIM(TITLE)
WRITE(LU_OUTPUT,'(A,A/)')     ' Job ID string    : ',TRIM(CHID)
 
IF (APPEND) RETURN
 
MESH_LOOP: DO NM=1,NMESHES
   M => MESHES(NM)
   WRITE(LU_OUTPUT,'(/A,I5/)') ' Grid Dimensions, Mesh ',NM
   WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the X Direction      ',M%IBAR
   WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Y Direction      ',M%JBAR
   WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Z Direction      ',M%KBAR
   WRITE(LU_OUTPUT,'(//A,I5/)')' Physical Dimensions, Mesh ',NM
   WRITE(LU_OUTPUT,'(A,F9.3)')   '   Length (m)                    ',M%XF-M%XS
   WRITE(LU_OUTPUT,'(A,F9.3)')   '   Width  (m)                    ',M%YF-M%YS
   WRITE(LU_OUTPUT,'(A,F9.3)')   '   Height (m)                    ',M%ZF-M%ZS
   WRITE(LU_OUTPUT,'(A,F8.3)')   '   Initial Time Step (s)         ',M%DT
ENDDO MESH_LOOP
WRITE(LU_OUTPUT,'(//A/)')     ' Miscellaneous Parameters'
IF (TIME_SHRINK_FACTOR /= 1._EB) &
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Time Shrink Factor (s/s)      ',TIME_SHRINK_FACTOR
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Simulation Start Time (s)     ',T_BEGIN
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Simulation End Time (s)       ',(T_END-T_BEGIN) * TIME_SHRINK_FACTOR + T_BEGIN
IF (LES) THEN
   WRITE(LU_OUTPUT,'(A)')        '   LES Calculation'
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Smagorinsky Constant          ',CSMAG
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Prandtl Number      ',PR
   IF (N_SPECIES>0._EB) WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Schmidt Number      ',SC
ENDIF
WRITE(LU_OUTPUT,'(A,F8.2)')   '   Ambient Temperature (C)       ',TMPA-TMPM
 
! Print out information about species
 
WRITE(LU_OUTPUT,'(//A)') ' Species Information'
SPEC_LOOP: DO N=0,N_SPECIES
   IF (N==0 .AND. MIXTURE_FRACTION) CYCLE SPEC_LOOP
   SS => SPECIES(N)
   WRITE(LU_OUTPUT,'(/3X,A)') SS%ID
   SELECT CASE(SS%MODE)
      CASE (MIXTURE_FRACTION_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Mixture Fraction Variable'
      CASE (GAS_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Gas Species'
      CASE (AEROSOL_SPECIES)            
         WRITE(LU_OUTPUT,'( 3X,A)') 'Aerosol'
   END SELECT
   IF (N==0) WRITE(LU_OUTPUT,'( 3X,A)') 'Background Species'
   IF (SS%MW <  1000._EB .AND. SS%MODE==GAS_SPECIES) &    
      WRITE(LU_OUTPUT,'(A,F8.2)')   '   Molecular Weight (g/mol)      ',SS%MW
   IF (SS%MW >= 1000._EB .AND. SS%MODE==GAS_SPECIES) &    
      WRITE(LU_OUTPUT,'(A,F8.2)')   '   Density (kg/m^3)              ',SS%MW*P_INF/(TMPA*R0)
   WRITE(LU_OUTPUT,'(A,F8.3)')   '   Initial Mass Fraction         ',SS%YY0
   IF (N==0) THEN
      IF (DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Viscosity (kg/m/s)   Ambient: ',Y2MU_C(NINT(TMPA))*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',Y2MU_C(773)*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',Y2MU_C(1273)*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',Y2MU_C(1773)*SPECIES(0)%MW
      ENDIF
      IF (.NOT.ISOTHERMAL .AND. DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Therm. Cond. (W/m/K) Ambient: ',Y2K_C(NINT(TMPA))*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',Y2K_C(773)*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',Y2K_C(1273)*SPECIES(0)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',Y2K_C(1773)*SPECIES(0)%MW
      ENDIF
      IF (.NOT.ISOTHERMAL .AND. DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Spec. Heat (J/kg/K)  Ambient: ',Y2CP_C(NINT(TMPA))
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',Y2CP_C(773)
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',Y2CP_C(1273)
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',Y2CP_C(1773)
      ENDIF
   ELSE   
      IF (DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Viscosity (kg/m/s)   Ambient: ',&
                                           (Y2MU_C(NINT(TMPA))+Y2MU(NINT(TMPA),N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',(Y2MU_C(773)+Y2MU(773,N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',(Y2MU_C(1273)+Y2MU(1273,N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',(Y2MU_C(1773)+Y2MU(1773,N))*SPECIES(N)%MW
      ENDIF
      IF (.NOT.ISOTHERMAL .AND. DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Therm. Cond. (W/m/K) Ambient: ',&
                                           (Y2K_C(NINT(TMPA))+Y2K(NINT(TMPA),N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',(Y2K_C( 773)+Y2K( 773,N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',(Y2K_C(1273)+Y2K(1273,N))*SPECIES(N)%MW
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',(Y2K_C(1773)+Y2K(1773,N))*SPECIES(N)%MW
      ENDIF
      IF (.NOT.ISOTHERMAL .AND. DNS .AND. SS%MODE==GAS_SPECIES) THEN
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Spec. Heat (J/kg/K)  Ambient: ',Y2CP_C(NINT(TMPA))+Y2CP(NINT(TMPA),N)
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',Y2CP_C( 773)+Y2CP( 773,N)
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',Y2CP_C(1273)+Y2CP(1273,N)
         WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',Y2CP_C(1773)+Y2CP(1773,N)
      ENDIF
   ENDIF
   IF (N>0 .AND. DNS .AND. SS%MODE==GAS_SPECIES) THEN
      WRITE(LU_OUTPUT,'(A,ES8.2)')  '   Diff. Coeff. (m^2/s) Ambient: ',SS%D(NINT(TMPA))
      WRITE(LU_OUTPUT,'(A,ES8.2)')  '                          500 C: ',SS%D( 773)
      WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1000 C: ',SS%D(1273)
      WRITE(LU_OUTPUT,'(A,ES8.2)')  '                         1500 C: ',SS%D(1773)
   ENDIF
ENDDO SPEC_LOOP
 
! Print out Stoichiometric parameters for mixture fraction model
 
IF (N_REACTIONS>0) WRITE(LU_OUTPUT,'(//A)') ' Gas Phase Reaction Information'
REACTION_LOOP: DO N=1,N_REACTIONS
   RN => REACTION(N)
   SELECT CASE(RN%MODE)
      CASE(MIXTURE_FRACTION_REACTION)
         IF (CO_PRODUCTION) THEN
            SELECT CASE(N)
               CASE(1)
                  WRITE(LU_OUTPUT,'(/3X,A)') 'Incomplete (CO Production) Reaction'
               CASE(2)
                  WRITE(LU_OUTPUT,'(/3X,A)') 'Complete (CO2 Production) Reaction'
               CASE(3)
                  WRITE(LU_OUTPUT,'(/3X,A)') 'Null (Extinction) Reaction'               
             END SELECT
         ELSE
            SELECT CASE(N)
               CASE(1)
                  WRITE(LU_OUTPUT,'(/3X,A)') 'Complete (CO2 Production) Reaction'
               CASE(2)
                  WRITE(LU_OUTPUT,'(/3X,A)') 'Null (Extinction) Reaction'               
             END SELECT
         ENDIF
         WRITE(LU_OUTPUT,'(3X,A)')  'Mixture Fraction Reaction'
      CASE(FINITE_RATE_REACTION)
         WRITE(LU_OUTPUT,'(/3X,A)') RN%NAME
         WRITE(LU_OUTPUT,'(3X,A)')  'Finte Rate Reaction'
   END SELECT
   IF (RN%FYI/='null') WRITE(LU_OUTPUT,'(3X,A)') RN%FYI
   WRITE(LU_OUTPUT,'(A,F8.2)')  '   Molecular Weight, Fuel (g/mol)',RN%MW_FUEL
   WRITE(LU_OUTPUT,'(A,F8.0)')  '   Heat of Combustion (kJ/kg)    ',RN%HEAT_OF_COMBUSTION/1000._EB
   SELECT CASE (RN%MODE)
      CASE (MIXTURE_FRACTION_REACTION)
         WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., O_2           ',RN%NU(O2_INDEX)
         WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., CO_2          ',RN%NU(CO2_INDEX)
         IF (H2O_INDEX > 0 .AND. H2O_INDEX <=N_STATE_SPECIES) &
            WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., H2O           ',RN%NU(H2O_INDEX)
         IF (SOOT_INDEX > 0 .AND. SOOT_INDEX <=N_STATE_SPECIES) &
            WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., Soot          ',RN%NU(SOOT_INDEX)
         IF (CO_INDEX > 0 .AND. CO_INDEX <=N_STATE_SPECIES)  &
            WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., CO            ',RN%NU(CO_INDEX)  
         WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., N_2           ',RN%NU(N2_INDEX)           
         IF (OTHER_INDEX > 0 .AND. OTHER_INDEX <=N_STATE_SPECIES) &
            WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoich. Coeff., Other         ',RN%NU(OTHER_INDEX)
         WRITE(LU_OUTPUT,'(A,F8.3)')  '   Stoichiometric Value of Z     ',RN%Z_F
      CASE (FINITE_RATE_REACTION)
         DO NN=1,N_SPECIES
            WRITE(LU_OUTPUT,'(A,A15,F8.3)')  '   Stoich. Coeff. ',TRIM(SPECIES(NN)%ID),RN%NU(NN) 
         ENDDO
         DO NN=1,N_SPECIES
            IF(RN%N(NN)==-999._EB) THEN
               WRITE(LU_OUTPUT,'(A,A15,F8.3)')  '    Rate Exponent ',TRIM(SPECIES(NN)%ID),0. 
            ELSE
               WRITE(LU_OUTPUT,'(A,A15,F8.3)')  '    Rate Exponent ',TRIM(SPECIES(NN)%ID),RN%N(NN) 
            ENDIF
         ENDDO
   END SELECT
ENDDO REACTION_LOOP

! Print out information about materials
 
WRITE(LU_OUTPUT,'(//A,I2)')  ' Material Information'
 
MATL_LOOP: DO N=1,N_MATL
   ML => MATERIAL(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,MATL_NAME(N)
   IF (ML%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(ML%FYI)
   WRITE(LU_OUTPUT,'(A,F8.3)')    '     Emissivity                   ',ML%EMISSIVITY
   WRITE(LU_OUTPUT,'(A,F8.1)')    '     Density (kg/m3)              ',ML%RHO_S
   IF (ML%C_S>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '     Specific Heat (kJ/kg/K)      ',ML%C_S*0.001_EB
   ELSE
      NR = -NINT(ML%C_S)
      WRITE(LU_OUTPUT,'(A,F8.2)') '     Specific Heat (kJ/kg/K)      ',EVALUATE_RAMP(TMPA,0._EB,NR)
   ENDIF
   IF (ML%K_S>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.4)') '     Conductivity (W/m/K)         ',ML%K_S
   ELSE
      NR = -NINT(ML%K_S)
      WRITE(LU_OUTPUT,'(A,F8.4)') '     Conductivity (W/m/K)         ',EVALUATE_RAMP(TMPA,0._EB,NR)
   ENDIF
   IF (ML%KAPPA_S<1.0E4_EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '     Absorption coefficient (1/m) ',ML%KAPPA_S
   ENDIF
   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_SOLID) THEN
   DO NN=1,ML%N_REACTIONS
      WRITE(LU_OUTPUT,'(A,I2)')   '     Reaction ', NN
      IF (ML%NU_RESIDUE(NN) > 0._EB) WRITE(LU_OUTPUT,'(A,A,A,I2,A,F6.3)') &
                            '        Residue: ',TRIM(ML%RESIDUE_MATL_NAME(NN)),', Material Index: ', &
                                                     ML%RESIDUE_MATL_INDEX(NN),', Yield: ',ML%NU_RESIDUE(NN)
      WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
      DO NS = 1,N_SPECIES
      WRITE(LU_OUTPUT,'(A,A,A,F8.2)')'        ',SPECIES(NS)%ID,': ',ML%NU_GAS(NN,NS)
      ENDDO
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        A (1/s)    : ',ML%A(NN)
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        E (kJ/kmol): ',ML%E(NN)/1000.
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        H_R (kJ/kg): ',ML%H_R(NN)/1000.
      WRITE(LU_OUTPUT,'(A,F8.2)') '        N_S        : ',ML%N_S(NN)
      IF (ML%TMP_THR(NN)>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '        Threshold temperature (C): ',ML%TMP_THR(NN)-TMPM
      WRITE(LU_OUTPUT,'(A,F8.2)') '        N_T        : ',ML%N_T(NN)
      ENDIF
   ENDDO
   ENDIF
   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_LIQUID) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Liquid evaporation reaction'
      WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
      DO NS = 1,N_SPECIES
      WRITE(LU_OUTPUT,'(A,A,A,F8.2)')'        ',SPECIES(NS)%ID,': ',ML%NU_GAS(1,NS)
      ENDDO      
      WRITE(LU_OUTPUT,'(A,F8.2)') '        Boiling temperature (C): ',ML%TMP_BOIL-TMPM
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        H_R (kJ/kg)            : ',ML%H_R(1)/1000.
   ENDIF
ENDDO MATL_LOOP
 
! Print out information about surface types
 
WRITE(LU_OUTPUT,'(//A,I2)')  ' Surface Conditions'
 
SURFLOOP: DO N=0,N_SURF
 
   SF => SURFACE(N)
   IF (N==DEFAULT_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(/I4,1X,A,A)')  N,TRIM(SF%ID),' (DEFAULT)'
   ELSE
      WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,TRIM(SF%ID)
   ENDIF
   IF (SF%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(SF%FYI)
   IF (N==OPEN_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Passive Vent to Atmosphere'
      CYCLE SURFLOOP
   ENDIF
   IF (N==MIRROR_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Symmetry Plane'
      CYCLE SURFLOOP
   ENDIF
 
   THICK: IF (SF%THERMAL_BC_INDEX == THERMALLY_THICK) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Material List'
      DO NN=1,SF%N_MATL
         WRITE(LU_OUTPUT,'(8X,I3,2X,A)') NN,SF%MATL_NAME(NN)
      ENDDO
      IF (SF%SHRINK)          WRITE(LU_OUTPUT,'(A)')'     Shrinking wall'
      SD = 0._EB      
      DO NL=1,SF%N_LAYERS
         WRITE(LU_OUTPUT,'(A,I2)')      '     Layer ',NL
         WRITE(LU_OUTPUT,'(A,F8.5)')    '        Thickness   (m): ',SF%LAYER_THICKNESS(NL)
         WRITE(LU_OUTPUT,'(A,F8.2)')    '        Density (kg/m3): ',SF%LAYER_DENSITY(NL)
         ! ToDo: cylindrical and spherical surfaces
         SD = SD + SF%LAYER_THICKNESS(NL)*SF%LAYER_DENSITY(NL)
         DO NN=1,SF%N_LAYER_MATL(NL)
            WRITE(LU_OUTPUT,'(8X,A,A,F7.2)') TRIM(SF%LAYER_MATL_NAME(NL,NN)),', Mass fraction: ',SF%LAYER_MATL_FRAC(NL,NN)
         ENDDO
      ENDDO
      WRITE(LU_OUTPUT,'(A,F9.3,A)')     '     Total surface density ', SD, ' kg/m2'
      WRITE(LU_OUTPUT,'(A,F5.2,A)')     '     Reaction products considered from the first ',SF%LAYER_DIVIDE, ' layers.'
      WRITE(LU_OUTPUT,'(A)')            '     Solid Phase Nodes (m):      '
      DO I=0,SF%N_CELLS
         WRITE(LU_OUTPUT,'(10X,I3, F10.5)') I,SF%X_S(I)
      ENDDO
      IF (SF%GEOMETRY==SURF_CARTESIAN) THEN
         IF (SF%BACKING==VOID)      WRITE(LU_OUTPUT,'(A)') '     Backing to void'
         IF (SF%BACKING==INSULATED) WRITE(LU_OUTPUT,'(A)') '     Insulated Backing'
         IF (SF%BACKING==EXPOSED)   WRITE(LU_OUTPUT,'(A)') '     Exposed Backing'
      ENDIF
      IF (SF%GEOMETRY==SURF_CYLINDRICAL) WRITE(LU_OUTPUT,'(A)') '     Assumed cylindrical symmetry'
      IF (SF%GEOMETRY==SURF_SPHERICAL)   WRITE(LU_OUTPUT,'(A)') '     Assumed spherical symmetry'
   ENDIF THICK
 
   IF (SF%THERMAL_BC_INDEX==SPECIFIED_TEMPERATURE) &
                                  WRITE(LU_OUTPUT,'(A,F8.1)') '     Wall or Vent Temperature (C)', SF%TMP_FRONT - TMPM
   IF (SF%VEL/=0._EB)             WRITE(LU_OUTPUT,'(A,F8.3)') '     Normal Velocity (m/s)       ', SF%VEL
   IF (SF%MASS_FLUX_TOTAL/=0._EB) WRITE(LU_OUTPUT,'(A,F8.3)') '     Total Mass Flux (kg/m^2/s)  ', SF%MASS_FLUX_TOTAL
   IF (SF%VOLUME_FLUX/=0._EB)     WRITE(LU_OUTPUT,'(A,F8.3)') '     Volume Flux (m**3/s)        ', SF%VOLUME_FLUX
   IF (N_SPECIES>0 .AND. .NOT.MIXTURE_FRACTION) THEN
      DO NN=1,N_SPECIES
         IF (SF%MASS_FRACTION(NN)>=0._EB) WRITE(LU_OUTPUT,'(A,I1,A,8X,F6.3)') &
                  '     Species ',NN,' Mass Fraction',SF%MASS_FRACTION(NN)
         IF (SF%MASS_FLUX(NN)/=0._EB) WRITE(LU_OUTPUT,'(A,I1,A,2X,F6.3)') &
                  '     Species ',NN,' Mass Flux (kg/s/m2)',SF%MASS_FLUX(NN)
      ENDDO
   ENDIF
 
   IF (MIXTURE_FRACTION) THEN
      IF (CO_PRODUCTION) THEN
         IF (SF%MASS_FLUX(I_FUEL)>0._EB) WRITE(LU_OUTPUT,'(A,F8.1)') '     HRR Per Unit Area (kW/m2)     ', &
               SF%MASS_FLUX(I_FUEL)*REACTION(2)%HEAT_OF_COMBUSTION* REACTION(2)%Y_F_INLET*0.001_EB
      ELSE
         IF (SF%MASS_FLUX(I_FUEL)>0._EB) WRITE(LU_OUTPUT,'(A,F8.1)') '     HRR Per Unit Area (kW/m2)     ', &
               SF%MASS_FLUX(I_FUEL)*REACTION(1)%HEAT_OF_COMBUSTION* REACTION(1)%Y_F_INLET*0.001_EB
      ENDIF
   ENDIF

   IF (SF%CONV_LENGTH /= 1._EB) WRITE(LU_OUTPUT,'(A,ES9.2)') '     Convection length scale (m) ', SF%CONV_LENGTH
 
ENDDO SURFLOOP
 
! Print out information about all Devices
 
IF (N_PROP > 0) WRITE(LU_OUTPUT,'(//A,I2)')  ' Device Properties'

PROPERTY_LOOP: DO N=1,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')  N,TRIM(PY%ID)
   QUANTITY = PY%QUANTITY
   SELECT CASE(QUANTITY)
      CASE('NOZZLE')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('SPRINKLER LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.2)') '     C-Factor (m/s)^1/2          ', PY%C_FACTOR
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     K-Factor (L/min/atm**0.5)   ', PY%K_FACTOR
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
      CASE('CABLE TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.4)') '     Diameter (m)                ', PY%CABLE_DIAMETER
         WRITE(LU_OUTPUT,'(A,F8.3)') '     Mass per unit length (kg/m) ', PY%CABLE_MASS_PER_LENGTH
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Failure Temperature (C)     ', PY%CABLE_FAILURE_TEMPERATURE
      CASE('CHAMBER OBSCURATION')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Activation Obscuration (%/m)', PY%ACTIVATION_OBSCURATION 
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_c or L                ', PY%ALPHA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_c                      ', PY%BETA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_e                     ', PY%ALPHA_E
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_e                      ', PY%BETA_E
   END SELECT
   WRITE(LU_OUTPUT,'(A,A   )') '     Smokeview ID                ', TRIM(PY%SMOKEVIEW_ID(1))
ENDDO PROPERTY_LOOP
 
! Print out DEVICE locations and info    
 
IF (N_DEVC>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Device Coordinates'
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%SPEC_INDEX>0) THEN
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY), &
            ', Species: ',TRIM(SPECIES(DV%SPEC_INDEX)%ID)
      ELSEIF (DV%PART_INDEX>0) THEN
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY), &
            ', Particle Class: ',TRIM(PARTICLE_CLASS(DV%PART_INDEX)%ID)
      ELSE
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY)
      ENDIF
   ENDDO
ENDIF
 
! Write out PLOT3D Info
 
IF (DT_PL3D<T_END) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' PLOT3D Information'
   WRITE(LU_OUTPUT,'(A,F8.1/)')'   Sampling Interval (s)          ',DT_PL3D
   DO N=1,5
      IF (PLOT3D_SPEC_INDEX(N)>0) THEN
         WRITE(LU_OUTPUT,'(I4,A,A,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N)), &
            ', Species: ',TRIM(SPECIES(PLOT3D_SPEC_INDEX(N))%ID)
      ELSE
         WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N))
      ENDIF
   ENDDO
ENDIF
 
! Write out Isosurface File Info
 
IF (N_ISOF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Isosurface File Information'
   WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_ISOF
   DO N=1,N_ISOF
      IS => ISOSURFACE_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A,A,10F8.3)')N,' Quantity: ',TRIM(IS%SMOKEVIEW_LABEL),', VALUE(s):',(IS%VALUE(I),I=1,IS%N_VALUES)
   ENDDO
ENDIF
 
! Write out Slice File Info
 
MESH_LOOP_4: DO NM=1,NMESHES
   M => MESHES(NM)
   IF (M%N_SLCF>0) THEN
      WRITE(LU_OUTPUT,'(//A,I5/)')   ' Slice File Information, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_SLCF
      DO N=1,M%N_SLCF
         SL=> M%SLICE(N)
         WRITE(LU_OUTPUT,'(I4,A,6I4,A,A)') N,' Nodes:',SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2,', Quantity: ',TRIM(SL%SMOKEVIEW_LABEL)
      ENDDO
   ENDIF
ENDDO MESH_LOOP_4
 
! Write out Boundary File info
 
IF (N_BNDF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Boundary File Information'
   WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_BNDF
   DO N=1,N_BNDF
      BF => BOUNDARY_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(BF%SMOKEVIEW_LABEL)
   ENDDO
ENDIF
 
! Write out radiation info
 
WRITE_RADIATION: IF (RADIATION) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Radiation Model Information'
   WRITE(LU_OUTPUT,'(A,I4)')   '   Number of control angles ', NUMBER_RADIATION_ANGLES
   WRITE(LU_OUTPUT,'(A,I4)')   '   Time step increment      ', TIME_STEP_INCREMENT
   WRITE(LU_OUTPUT,'(A,I4)')   '   Angle increment          ', ANGLE_INCREMENT
   IF (CYLINDRICAL .OR. .NOT.TWO_D) THEN
      WRITE(LU_OUTPUT,'(A)')   '   Theta band N_phi   Solid angle'
   ELSE
      WRITE(LU_OUTPUT,'(A)')   '   Phi band   N_theta Solid angle'
   ENDIF
   N = 1
   DO I=1,NRT
      WRITE(LU_OUTPUT,'(I6,A,I6,F6.2)') I,':   ',NRP(I),RSA(N)
      N = N + NRP(I)
   ENDDO
   IF (NUMBER_SPECTRAL_BANDS>1) THEN
      WRITE(LU_OUTPUT,'(A,I4)')  '   Number of spectral bands is ', NUMBER_SPECTRAL_BANDS
   ELSE
      IF (MIXTURE_FRACTION) THEN
         WRITE(LU_OUTPUT,'(A,I4)')  '   Using gray gas absorption.'
         WRITE(LU_OUTPUT,'(A,F6.3,A)')'   Mean beam length ',PATH_LENGTH,' m'
      ELSE
         WRITE(LU_OUTPUT,'(A,F6.2,A)')'   Constant absorption coeff. ',KAPPA0
      ENDIF
   ENDIF
ENDIF WRITE_RADIATION
 
WRITE(LU_OUTPUT,*)
WRITE(LU_OUTPUT,*)
 
END SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE
 
 
SUBROUTINE DUMP_CORE(T,NM)

! Dump data to a file for possible restart

USE MEMORY_FUNCTIONS, ONLY: REALLOCATE
REAL(EB), INTENT(IN) :: T
INTEGER :: IBC,NOM,IW,N
INTEGER, INTENT(IN) :: NM
TYPE(OMESH_TYPE), POINTER :: M2=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN  ! No restart for evacuation
OPEN(LU_CORE(NM),FILE=FN_CORE(NM),FORM='UNFORMATTED',STATUS='REPLACE')

CALL POINT_TO_MESH(NM)
WRITE(LU_CORE(NM)) U
WRITE(LU_CORE(NM)) V
WRITE(LU_CORE(NM)) W
WRITE(LU_CORE(NM)) D
WRITE(LU_CORE(NM)) H
WRITE(LU_CORE(NM)) RHO
WRITE(LU_CORE(NM)) TMP
WRITE(LU_CORE(NM)) Q
WRITE(LU_CORE(NM)) QR
WRITE(LU_CORE(NM)) UII
IF (RADIATION) WRITE(LU_CORE(NM)) UIID
WRITE(LU_CORE(NM)) UW
WRITE(LU_CORE(NM)) UWS
WRITE(LU_CORE(NM)) TMP_F
WRITE(LU_CORE(NM)) TMP_B
WRITE(LU_CORE(NM)) MASSFLUX
WRITE(LU_CORE(NM)) RHODW
WRITE(LU_CORE(NM)) QRADIN
WRITE(LU_CORE(NM)) QRADOUT
IF (N_EVAP_INDICES>0) WRITE(LU_CORE(NM)) QR_W
WRITE(LU_CORE(NM)) TW
WRITE(LU_CORE(NM)) EW
WRITE(LU_CORE(NM)) KW
WRITE(LU_CORE(NM)) RHO_F
WRITE(LU_CORE(NM)) WMPUA 
WRITE(LU_CORE(NM)) WCPUA 
IF (ACCUMULATE_WATER) WRITE(LU_CORE(NM)) AWMPUA 
WRITE(LU_CORE(NM)) SOLID
WRITE(LU_CORE(NM)) EDGE_INDEX
WRITE(LU_CORE(NM)) IJKW
WRITE(LU_CORE(NM)) IJKE
WRITE(LU_CORE(NM)) OME_E
WRITE(LU_CORE(NM)) TAU_E
WRITE(LU_CORE(NM)) BOUNDARY_TYPE
WRITE(LU_CORE(NM)) INC
WRITE(LU_CORE(NM)) NWC
WRITE(LU_CORE(NM)) NPATCH

DO IW=1,NWC
   WRITE(LU_CORE(NM)) WALL(IW)%ALREADY_ALLOCATED
ENDDO
DO IW=1,NWC
   IF (.NOT.WALL(IW)%ALREADY_ALLOCATED) CYCLE
   IBC = IJKW(5,IW)
   IF (SURFACE(IBC)%THERMALLY_THICK) THEN
      IF (SURFACE(IBC)%SHRINK) THEN
         WRITE(LU_CORE(NM)) WALL(IW)%N_LAYER_CELLS,WALL(IW)%LAYER_THICKNESS,WALL(IW)%X_S
         IF (SUM(WALL(IW)%N_LAYER_CELLS)>0) WRITE(LU_CORE(NM)) WALL(IW)%TMP_S,WALL(IW)%RHO_S
      ELSE
         IF (SURFACE(IBC)%N_CELLS>0) WRITE(LU_CORE(NM)) WALL(IW)%TMP_S,WALL(IW)%RHO_S
      ENDIF
   ENDIF
   IF (RADIATION .AND. BOUNDARY_TYPE(IW)/=OPEN_BOUNDARY) WRITE(LU_CORE(NM)) WALL(IW)%ILW
ENDDO
IF (N_SPECIES>0) WRITE(LU_CORE(NM)) YY
IF (N_SPECIES>0) WRITE(LU_CORE(NM)) DEL_RHO_D_DEL_Y
IF (N_SPECIES>0) WRITE(LU_CORE(NM)) YY_F
IF (DROPLET_FILE) THEN
   WRITE(LU_CORE(NM)) NLP,NLPDIM
   WRITE(LU_CORE(NM)) DROPLET(1:NLP)
ENDIF
DO N=1,N_INIT
   IN => INITIALIZATION(N)
   WRITE(LU_CORE(NM)) IN%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO
DO N=1,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_CORE(NM)) PY%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO
DO N=1,N_SURF
   SF => SURFACE(N)
   WRITE(LU_CORE(NM)) SF%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO

WRITE(LU_CORE(NM)) T,ICYC,PART_CLOCK(NM),CORE_CLOCK(NM),SLCF_CLOCK(NM), &
             PL3D_CLOCK(NM),BNDF_CLOCK(NM),DEVC_CLOCK,HRR_CLOCK,MINT_CLOCK, &
             ISOF_CLOCK(NM),BC_CLOCK,WALL_COUNTER,DT_PREV,DT_NEXT, &
             PBAR,D_PBAR_DT,N_EDGES,RAD_CALL_COUNTER,ANGLE_INC_COUNTER
DO N=1,N_DEVC
   DV => DEVICE(N)
   WRITE(LU_CORE(NM)) DV%INSTANT_VALUE,DV%VALUE,DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%TIME_INTERVAL,DV%CURRENT_STATE,DV%PRIOR_STATE
   IF (DV%QUANTITY=='CHAMBER OBSCURATION') THEN
      WRITE(LU_CORE(NM)) UBOUND(DV%T_E,1) 
      WRITE(LU_CORE(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY=='ASPIRATION') THEN
      WRITE(LU_CORE(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF   
   IF (DV%STATISTICS=='TIME INTEGRAL') THEN
      WRITE(LU_CORE(NM)) DV%TI_T,DV%TI_VALUE
   ENDIF
ENDDO
DO N=1,N_CTRL
   WRITE(LU_CORE(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE
ENDDO

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   IF (NIC(NM,NOM)==0) CYCLE OTHER_MESH_LOOP
   IF (EVACUATION_ONLY(NOM)) CYCLE OTHER_MESH_LOOP
   M2=>MESHES(NM)%OMESH(NOM)
   WRITE(LU_CORE(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   IF (N_SPECIES>0) WRITE(LU_CORE(NM)) M2%YY,M2%YYS
   WRITE(LU_CORE(NM)) M2%IJKW
ENDDO OTHER_MESH_LOOP
CLOSE(LU_CORE(NM))

END SUBROUTINE DUMP_CORE


SUBROUTINE READ_RESTART(T,NM)

! Read data from a previous calculation

USE COMP_FUNCTIONS, ONLY:SHUTDOWN
USE MEMORY_FUNCTIONS, ONLY: REALLOCATE,ALLOCATE_WALL_ARRAYS
REAL(EB), INTENT(OUT) :: T
INTEGER :: IBC,NOM,IW,N,N_T_E_MAX
INTEGER, INTENT(IN) :: NM
LOGICAL :: EX
CHARACTER(100) :: MESSAGE
TYPE(OMESH_TYPE), POINTER :: M2=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN ! No restart for evacuation
INQUIRE(FILE=FN_RESTART(NM),EXIST=EX)
IF (.NOT.EX) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_RESTART(NM)),", does not exist in the current directory"
   CALL SHUTDOWN(MESSAGE)
ENDIF

OPEN(LU_RESTART(NM),FILE=FN_RESTART(NM),FORM='UNFORMATTED',STATUS='OLD')

CALL POINT_TO_MESH(NM)

READ(LU_RESTART(NM))  U
READ(LU_RESTART(NM))  V
READ(LU_RESTART(NM))  W
READ(LU_RESTART(NM))  D
READ(LU_RESTART(NM))  H
READ(LU_RESTART(NM))  RHO
READ(LU_RESTART(NM))  TMP
READ(LU_RESTART(NM))  Q
READ(LU_RESTART(NM))  QR
READ(LU_RESTART(NM)) UII
IF (RADIATION) READ(LU_RESTART(NM)) UIID
READ(LU_RESTART(NM))  UW
READ(LU_RESTART(NM))  UWS
READ(LU_RESTART(NM))  TMP_F
READ(LU_RESTART(NM))  TMP_B
READ(LU_RESTART(NM))  MASSFLUX
READ(LU_RESTART(NM))  RHODW
READ(LU_RESTART(NM))  QRADIN
READ(LU_RESTART(NM))  QRADOUT
IF (N_EVAP_INDICES>0) READ(LU_RESTART(NM))  QR_W
READ(LU_RESTART(NM))  TW
READ(LU_RESTART(NM))  EW
READ(LU_RESTART(NM))  KW
READ(LU_RESTART(NM))  RHO_F
READ(LU_RESTART(NM)) WMPUA 
READ(LU_RESTART(NM)) WCPUA 
IF (ACCUMULATE_WATER) READ(LU_RESTART(NM)) AWMPUA 
READ(LU_RESTART(NM))  SOLID
READ(LU_RESTART(NM))  EDGE_INDEX
READ(LU_RESTART(NM))  IJKW
READ(LU_RESTART(NM))  IJKE
READ(LU_RESTART(NM))  OME_E
READ(LU_RESTART(NM))  TAU_E
READ(LU_RESTART(NM))  BOUNDARY_TYPE
READ(LU_RESTART(NM))  INC
READ(LU_RESTART(NM))  NWC
READ(LU_RESTART(NM))  NPATCH

DO IW=1,NWC
   READ(LU_RESTART(NM)) WALL(IW)%ALREADY_ALLOCATED
   IF (WALL(IW)%ALREADY_ALLOCATED) CALL ALLOCATE_WALL_ARRAYS(NM,IW)
ENDDO
DO IW=1,NWC
   IF (.NOT.WALL(IW)%ALREADY_ALLOCATED) CYCLE
   IBC = IJKW(5,IW)
   IF (SURFACE(IBC)%THERMALLY_THICK) THEN
      IF (SURFACE(IBC)%SHRINK) THEN
         READ(LU_RESTART(NM)) WALL(IW)%N_LAYER_CELLS,WALL(IW)%LAYER_THICKNESS,WALL(IW)%X_S
         IF (SUM(WALL(IW)%N_LAYER_CELLS)>0) THEN
            NULLIFY(WALL(IW)%TMP_S)
            ALLOCATE(WALL(IW)%TMP_S(0:SURFACE(IBC)%N_CELLS+1))
            NULLIFY(WALL(IW)%RHO_S)
            ALLOCATE(WALL(IW)%RHO_S(0:SURFACE(IBC)%N_CELLS+1,SURFACE(IBC)%N_MATL))
            READ(LU_RESTART(NM)) WALL(IW)%TMP_S,WALL(IW)%RHO_S
         ENDIF
      ELSE
         IF (SURFACE(IBC)%N_CELLS>0) THEN
            NULLIFY(WALL(IW)%TMP_S)
            ALLOCATE(WALL(IW)%TMP_S(0:SURFACE(IBC)%N_CELLS+1))
            NULLIFY(WALL(IW)%RHO_S)
            ALLOCATE(WALL(IW)%RHO_S(0:SURFACE(IBC)%N_CELLS+1,SURFACE(IBC)%N_MATL))
            READ(LU_RESTART(NM)) WALL(IW)%TMP_S,WALL(IW)%RHO_S
         ENDIF
      ENDIF
   ENDIF
   IF (RADIATION .AND. BOUNDARY_TYPE(IW)/=OPEN_BOUNDARY) READ(LU_RESTART(NM)) WALL(IW)%ILW
ENDDO
IF (N_SPECIES>0) READ(LU_RESTART(NM))  YY
IF (N_SPECIES>0) READ(LU_RESTART(NM))  DEL_RHO_D_DEL_Y
IF (N_SPECIES>0) READ(LU_RESTART(NM))  YY_F
IF (DROPLET_FILE) THEN
   READ(LU_RESTART(NM)) NLP,NLPDIM
   DEALLOCATE(MESHES(NM)%DROPLET)
   ALLOCATE(MESHES(NM)%DROPLET(1:NLPDIM))
   READ(LU_RESTART(NM)) MESHES(NM)%DROPLET(1:NLP)
ENDIF

DO N=1,N_INIT
   IN => INITIALIZATION(N)
   READ(LU_RESTART(NM)) IN%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO
DO N=1,N_PROP
   PY => PROPERTY(N)
   READ(LU_RESTART(NM)) PY%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO
DO N=1,N_SURF
   SF => SURFACE(N)
   READ(LU_RESTART(NM)) SF%PARTICLE_INSERT_CLOCK(1:NMESHES)
ENDDO


READ(LU_RESTART(NM)) T,ICYC,PART_CLOCK(NM),CORE_CLOCK(NM),SLCF_CLOCK(NM), &
             PL3D_CLOCK(NM),BNDF_CLOCK(NM),DEVC_CLOCK,HRR_CLOCK,MINT_CLOCK, &
             ISOF_CLOCK(NM),BC_CLOCK,WALL_COUNTER,DT_PREV,DT_NEXT, &
             PBAR,D_PBAR_DT,N_EDGES,RAD_CALL_COUNTER,ANGLE_INC_COUNTER
DO N=1,N_DEVC
   DV => DEVICE(N)
   READ(LU_RESTART(NM)) DV%INSTANT_VALUE,DV%VALUE,DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%TIME_INTERVAL,DV%CURRENT_STATE,DV%PRIOR_STATE
   IF (DV%QUANTITY=='CHAMBER OBSCURATION') THEN
      READ(LU_RESTART(NM)) N_T_E_MAX 
      DV%T_E => REALLOCATE(DV%T_E,-1,N_T_E_MAX) 
      DV%Y_E => REALLOCATE(DV%Y_E,-1,N_T_E_MAX) 
      READ(LU_RESTART(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY=='ASPIRATION') THEN
      READ(LU_RESTART(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF   
   IF (DV%STATISTICS=='TIME INTEGRAL') THEN
      READ(LU_RESTART(NM)) DV%TI_T,DV%TI_VALUE
   ENDIF
ENDDO
DO N=1,N_CTRL
   READ(LU_RESTART(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE
ENDDO

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   IF (NIC(NM,NOM)==0) CYCLE OTHER_MESH_LOOP
   IF (EVACUATION_ONLY(NOM)) CYCLE OTHER_MESH_LOOP
   M2=>MESHES(NM)%OMESH(NOM)
   READ(LU_RESTART(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   IF (N_SPECIES>0) READ(LU_RESTART(NM)) M2%YY,M2%YYS
   READ(LU_RESTART(NM)) M2%IJKW
ENDDO OTHER_MESH_LOOP

CLOSE(LU_RESTART(NM))

END SUBROUTINE READ_RESTART


SUBROUTINE WRITE_DIAGNOSTICS(T)

! Write cycle number, elapsed time since the last call,
! current time for the physical system, and current number of
! particles in the system.

REAL(EB), INTENT(IN) :: T(NMESHES)
INTEGER :: NM,DATE_TIME(8),II,JJ,KK
CHARACTER(10) :: BIG_BEN(3),MONTH

IF (ICYC==1) WRITE(LU_OUTPUT,100)

CALL DATE_AND_TIME(BIG_BEN(1),BIG_BEN(2),BIG_BEN(3),DATE_TIME)
SELECT CASE(DATE_TIME(2))
   CASE(1)
      MONTH='January'
   CASE(2) 
      MONTH='February'
   CASE(3) 
      MONTH='March'
   CASE(4) 
      MONTH='April'
   CASE(5) 
      MONTH='May'
   CASE(6) 
      MONTH='June'
   CASE(7) 
      MONTH='July'
   CASE(8) 
      MONTH='August'
   CASE(9) 
      MONTH='September'
   CASE(10)
      MONTH='October'
   CASE(11)
      MONTH='November'
   CASE(12)
      MONTH='December'
END SELECT

WRITE(LU_ERR,'(1X,A,I7,A,F10.2,A)')  'Time Step:',ICYC,',    Simulation Time:',T(1),' s'

WRITE(LU_OUTPUT,'(7X,A,I7,3X,A,I3,A,I4,2X,I2.2,A,I2.2,A,I2.2)')  &
    'Time Step ',ICYC,TRIM(MONTH),DATE_TIME(3),', ',DATE_TIME(1), &
    DATE_TIME(5),':',DATE_TIME(6),':',DATE_TIME(7)
IF (ITERATE_PRESSURE) THEN
   NM = MAXLOC(VELOCITY_ERROR_MAX,1)
   II = VELOCITY_ERROR_MAX_I(NM)
   JJ = VELOCITY_ERROR_MAX_J(NM)
   KK = VELOCITY_ERROR_MAX_K(NM)
   WRITE(LU_OUTPUT,'(7X,A,I6)') 'Pressure Iterations: ',PRESSURE_ITERATIONS
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,I3,A,3I4,A)') 'Maximum Velocity Error: ',MAXVAL(VELOCITY_ERROR_MAX), &
                                               ' on Mesh ',NM,' at (',II,JJ,KK,')'
ENDIF
WRITE(LU_OUTPUT,'(7X,A)') '----------------------------------------------'

DO NM=1,NMESHES
   IF (NMESHES>1) WRITE(LU_OUTPUT,'(6X,A,I4,A,I7)') ' Mesh ',NM,', Cycle ',NTCYC(NM)
   M => MESHES(NM)
   IF (T_ACCUM(NM)<60._EB) WRITE(LU_OUTPUT,110) T_PER_STEP(NM),T_ACCUM(NM)
   IF (T_ACCUM(NM)>=60._EB .AND. T_ACCUM(NM)<3600._EB) WRITE(LU_OUTPUT,112) T_PER_STEP(NM),T_ACCUM(NM)/60._EB
   IF (T_ACCUM(NM)>=3600._EB)  WRITE(LU_OUTPUT,113) T_PER_STEP(NM),T_ACCUM(NM)/3600._EB
   WRITE(LU_OUTPUT,111) M%DT,T(NM), M%CFL,M%ICFL,M%JCFL,M%KCFL, M%DIVMX,M%IMX,M%JMX,M%KMX, M%DIVMN,M%IMN,M%JMN,M%KMN
   IF (ABS(M%RESMAX)>1.E-8_EB)  WRITE(LU_OUTPUT,133) M%RESMAX,M%IRM,M%JRM,M%KRM
   IF (ABS(M%POIS_PTB)>1.E-10_EB)  WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Pert. : ',M%POIS_PTB
   IF (CHECK_POISSON) WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Error : ',M%POIS_ERR
   IF (DNS .OR. CHECK_VN) WRITE(LU_OUTPUT,230) M%VN,M%I_VN,M%J_VN,M%K_VN
   IF (M%NLP>0) WRITE(LU_OUTPUT,141) M%NLP
   IF (ABS(HRR(NM) )>1._EB) WRITE(LU_OUTPUT,119) HRR(NM)/1000._EB
   IF (ABS(RHRR(NM))>1._EB) WRITE(LU_OUTPUT,120) RHRR(NM)/1000._EB
ENDDO

WRITE(LU_OUTPUT,*)

100 FORMAT(/' Run Time Diagnostics'/)
110 FORMAT(6X,' CPU/step:  ',F8.3,' s, Total CPU:  ',F8.2,' s')
112 FORMAT(6X,' CPU/step:  ',F8.3,' s, Total CPU:  ',F8.2,' min')
113 FORMAT(6X,' CPU/step:  ',F8.3,' s, Total CPU:  ',F8.2,' hr')
111 FORMAT(6X,' Time step: ',F8.5,' s, Total time: ',F8.2,' s'/ &
        6X,' Max CFL number: ',E9.2,' at (',I3,',',I3,',',I3,')'/ &
        6X,' Max divergence: ',E9.2,' at (',I3,',',I3,',',I3,')'/ &
        6X,' Min divergence: ',E9.2,' at (',I3,',',I3,',',I3,')')
133 FORMAT(6X,' Max div. error: ',E9.2,' at (',I3,',',I3,',',I3,')')
230 FORMAT(6X,' Max VN  number: ',E9.2,' at (',I3,',',I3,',',I3,')')
119 FORMAT(6X,' Total Heat Release Rate:      ',F13.3,' kW')
120 FORMAT(6X,' Radiation Loss to Boundaries: ',F13.3,' kW')
421 FORMAT(6X,' Fire Resolution Index:        ',F12.3)
141 FORMAT(6X,' No. of Lagrangian Particles:  ',I12)

END SUBROUTINE WRITE_DIAGNOSTICS


SUBROUTINE DUMP_PART(T,NM)
USE MEMORY_FUNCTIONS, ONLY:CHKMEMERR 
! Dump Lagrangian particle data to CHID.prt5
 
INTEGER, INTENT(IN)  :: NM
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER  :: NPP,NPLIM,I,N,NN,IPC,IZERO
REAL(FB), ALLOCATABLE, DIMENSION(:) :: XP,YP,ZP
REAL(FB), ALLOCATABLE, DIMENSION(:,:) :: QP
INTEGER, ALLOCATABLE, DIMENSION(:) :: TA
 
IF (EVACUATION_ONLY(NM)) RETURN
CALL POINT_TO_MESH(NM)
 
! Write the current time to the prt5 file, then start looping through the particle classes

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
WRITE(LU_PART(NM)) STIME

PARTICLE_CLASS_LOOP: DO N=1,N_PART
   PC => PARTICLE_CLASS(N)
   ! Count the number of particles to dump out
   NPLIM = 0
   DO I=1,NLP
      DR=>DROPLET(I)
      IPC = DR%CLASS
      IF (DR%SHOW .AND. IPC==N) NPLIM = NPLIM + 1
   ENDDO
   
   ! Allocate some temporary 4 byte arrays just to hold the data that is to be dumped to the file
   ALLOCATE(TA(NPLIM),STAT=IZERO)
   CALL ChkMemErr('DUMP','TA',IZERO) 
   ALLOCATE(XP(NPLIM),STAT=IZERO)
   CALL ChkMemErr('DUMP','XP',IZERO) 
   ALLOCATE(YP(NPLIM),STAT=IZERO)
   CALL ChkMemErr('DUMP','YP',IZERO) 
   ALLOCATE(QP(NPLIM,PC%N_QUANTITIES),STAT=IZERO)
   CALL ChkMemErr('DUMP','QP',IZERO) 
   ALLOCATE(ZP(NPLIM),STAT=IZERO)
   CALL ChkMemErr('DUMP','ZP',IZERO) 
  
   ! Load particle data into single precision arrays
 
   NPP = 0
   LOAD_LOOP: DO I=1,NLP
      DR=>DROPLET(I)
      IPC = DR%CLASS
      IF (.NOT.DR%SHOW .OR. IPC/=N) CYCLE LOAD_LOOP
      NPP = NPP + 1
      IF (NPP > NPLIM) EXIT LOAD_LOOP
      TA(NPP) = DR%TAG
      XP(NPP) = DR%X
      YP(NPP) = DR%Y
      ZP(NPP) = DR%Z
      DO NN=1,PC%N_QUANTITIES
         SELECT CASE(PC%QUANTITIES_INDEX(NN))
            CASE( 6)  ! U-VELOCITY
               QP(NPP,NN) = DR%U
            CASE( 7)  ! V-VELOCITY
               QP(NPP,NN) = DR%V
            CASE( 8)  ! W-VELOCITY
               QP(NPP,NN) = DR%W
            CASE(34)  ! DROPLET_DIAMETER
               QP(NPP,NN) = 2.E6*DR%R
            CASE(35)  ! DROPLET_VELOCITY
               QP(NPP,NN) = SQRT(DR%U**2+DR%V**2+DR%W**2)
            CASE(36)  ! DROPLET_PHASE
               QP(NPP,NN) = DR%IOR
            CASE(37)  ! DROPLET_TEMPERATURE
               QP(NPP,NN) = DR%TMP - TMPM
            CASE(38)  ! DROPLET_MASS
               QP(NPP,NN) = 1.E9_EB*PC%FTPR*DR%R**3
            CASE(39)  ! DROPLET_AGE
               QP(NPP,NN) = T-DR%T
         END SELECT
      ENDDO
   ENDDO LOAD_LOOP
 
   ! Dump particle data into the .prt5 file
   WRITE(LU_PART(NM)) NPLIM
   WRITE(LU_PART(NM)) (XP(I),I=1,NPLIM),(YP(I),I=1,NPLIM),(ZP(I),I=1,NPLIM)
   WRITE(LU_PART(NM)) (TA(I),I=1,NPLIM)
   IF (PC%N_QUANTITIES > 0) WRITE(LU_PART(NM)) ((QP(I,NN),I=1,NPLIM),NN=1,PC%N_QUANTITIES)

   DEALLOCATE(XP)
   DEALLOCATE(YP)
   DEALLOCATE(ZP)
   DEALLOCATE(QP)
   DEALLOCATE(TA)

ENDDO PARTICLE_CLASS_LOOP
 
END SUBROUTINE DUMP_PART


SUBROUTINE DUMP_ISOF(T,NM)
REAL(EB), INTENT(IN) :: T
REAL(EB) :: SUM
REAL(FB) :: STIME
INTEGER  :: ISOOFFSET,DATAFLAG,I,J,K,N,ERROR
INTEGER, INTENT(IN) :: NM
REAL(EB), POINTER, DIMENSION(:,:,:) :: QUANTITY=>NULL(),B=>NULL(),S=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN
STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
DATAFLAG = 1
DRY=.FALSE.
CALL POINT_TO_MESH(NM)

! Set up blockage arrays

B => WORK1
B = 1._EB
S => WORK2
S = 0._EB

DO K=0,KBP1
   DO J=0,JBP1
      DO I=0,IBP1
         IF (SOLID(CELL_INDEX(I,J,K))) B(I,J,K) = 0._EB
      ENDDO
   ENDDO
ENDDO

IBLK = 1

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) IBLK(I,J,K) = 0
      ENDDO
   ENDDO
ENDDO

DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         SUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+ B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (SUM>0._EB) S(I,J,K) = 1._EB/SUM
      ENDDO
   ENDDO
ENDDO

! Run through ISOF files

QUANTITY => WORK3

ISOF_LOOP: DO N=1,N_ISOF
   IS => ISOSURFACE_FILE(N)
   ERROR = 0
   ISOOFFSET = 1

   ! Fill up the dummy array QUANTITY with the appropriate gas phase output

   DO K=0,KBP1
      DO J=0,JBP1
         DO I=0,IBP1
            QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IS%INDEX,IS%SPEC_INDEX,0,IS%VELO_INDEX,T,NM)
         ENDDO
      ENDDO
   ENDDO

   ! Average the data (which is assumed to be cell-centered) at cell corners

   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            QQ(I,J,K,1) = S(I,J,K)*(QUANTITY(I,J,K)*B(I,J,K)+ QUANTITY(I+1,J,K)*B(I+1,J,K)+ &
                                    QUANTITY(I,J,K+1)*B(I,J,K+1)+ QUANTITY(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                    QUANTITY(I,J+1,K)*B(I,J+1,K)+ QUANTITY(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                    QUANTITY(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY(I+1,J+1,K+1)*B(I+1,J+1,K+1))
         ENDDO
      ENDDO
   ENDDO

   IF (IS%INDEX2==0) THEN

      CALL ISO2FILE(TRIM(FN_ISOF(N,NM))//CHAR(0),STIME, QQ(0:IBAR,0:JBAR,0:KBAR,1),IBLK,IS%VALUE(1:IS%N_VALUES), &
       IS%N_VALUES,XPLT,IBP1,YPLT,JBP1,ZPLT,KBP1,ISOOFFSET,IS%REDUCE_TRIANGLES,ERROR)

   ELSE

      ! Fill up the dummy array QUANTITY with the appropriate gas phase output for coloring isosurface

      DO K=0,KBP1
         DO J=0,JBP1
            DO I=0,IBP1
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IS%INDEX2,IS%SPEC_INDEX,0,IS%VELO_INDEX,T,NM)
            ENDDO
         ENDDO
      ENDDO

      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               QQ(I,J,K,2) = S(I,J,K)*(QUANTITY(I,J,K)*B(I,J,K)+ QUANTITY(I+1,J,K)*B(I+1,J,K)+ &
                                       QUANTITY(I,J,K+1)*B(I,J,K+1)+ QUANTITY(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                       QUANTITY(I,J+1,K)*B(I,J+1,K)+ QUANTITY(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                       QUANTITY(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY(I+1,J+1,K+1)*B(I+1,J+1,K+1))
            ENDDO
         ENDDO
      ENDDO

      CALL ISOT2FILE(TRIM(FN_ISOF(N,NM))//CHAR(0),STIME,QQ(0:IBAR,0:JBAR,0:KBAR,1),DATAFLAG, &
      QQ(0:IBAR,0:JBAR,0:KBAR,2),IBLK,IS%VALUE(1:IS%N_VALUES), &
      IS%N_VALUES,XPLT,IBP1,YPLT,JBP1,ZPLT,KBP1,ISOOFFSET,IS%REDUCE_TRIANGLES,ERROR)

   ENDIF

ENDDO ISOF_LOOP

END SUBROUTINE DUMP_ISOF
 
 

SUBROUTINE DUMP_SMOKE3D(T,NM)

REAL(EB), INTENT(IN) :: T
INTEGER,  INTENT(IN) :: NM
INTEGER  :: DATAFLAG,DATAFLAG2,I,J,K
REAL(FB) :: DXX,MASS_EXT_COEF,STIME
REAL(EB), POINTER, DIMENSION(:,:,:) :: FF=>NULL()
REAL(FB), ALLOCATABLE, DIMENSION(:) :: QQ_PACK

IF (EVACUATION_ONLY(NM)) RETURN
DRY=.FALSE.
CALL POINT_TO_MESH(NM)
 
STIME   = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
MASS_EXT_COEF = MASS_EXTINCTION_COEFFICIENT
IF (SMOKE3D_SPEC_INDEX>0) MASS_EXT_COEF = SPECIES(SMOKE3D_SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
DXX     = DX(1)
FF => WORK3
 
DATA_LOOP: DO DATAFLAG=1,2
   DATAFLAG2 = DATAFLAG
   SELECT CASE(DATAFLAG)
      CASE(1)
         IF (SMOKE3D_QUANTITY_INDEX==11) THEN
            FF = Q*0.001_EB
            DATAFLAG2 = 2
         ELSE
            DO K=0,KBP1
               DO J=0,JBP1
                  DO I=0,IBP1
                     FF(I,J,K) = RHO(I,J,K)*GAS_PHASE_OUTPUT(I,J,K,SMOKE3D_QUANTITY_INDEX,SMOKE3D_SPEC_INDEX,0,0,T,NM)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF
      CASE(2)
         FF = Q*0.001_EB
   END SELECT

   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            QQ(I,J,K,1) = (FF(I,J,K)  +FF(I+1,J,K)  +FF(I,J,K+1)  +FF(I+1,J,K+1)+ &
                           FF(I,J+1,K)+FF(I+1,J+1,K)+FF(I,J+1,K+1)+FF(I+1,J+1,K+1))*0.125_FB
         ENDDO
      ENDDO
   ENDDO
 
   ALLOCATE(QQ_PACK(IBP1*JBP1*KBP1)) 
   QQ_PACK = PACK(QQ(0:IBAR,0:JBAR,0:KBAR,1),MASK=.TRUE.)
   CALL SMOKE3DTOFILE(TRIM(FN_SMOKE3D(DATAFLAG,NM))//CHAR(0),STIME,DXX,MASS_EXT_COEF,DATAFLAG,QQ_PACK,IBP1,JBP1,KBP1,&
            HRRPUV_MAX_SMV)
   DEALLOCATE(QQ_PACK)
   IF (SMOKE3D_QUANTITY_INDEX==11) EXIT DATA_LOOP
ENDDO DATA_LOOP
 
END SUBROUTINE DUMP_SMOKE3D
 
 
SUBROUTINE DUMP_SLCF(T,NM,IFRMT)

! Write either Slice File or Plot3D file data to file(s)

USE MEMORY_FUNCTIONS, ONLY : RE_ALLOCATE_STRINGS 
USE MATH_FUNCTIONS, ONLY : RLE_COMPRESSION,TWO_BYTE_REAL
INTEGER, INTENT(IN) :: NM
REAL(EB), INTENT(IN) :: T
REAL(EB) :: SUM,XI,YJ,ZK,DROPMASS,RVC,TT
INTEGER :: IFRMT,I,J,K,IPC,II,JJ,KK,NQT,I1,I2,J1,J2,K1,K2,ITM,ITM1,IQ,IQQ,IND,NQ,NRLE,II1,II2,JJ1,JJ2,KK1,KK2, &
           IC,SPEC_INDEX,PART_INDEX,VELO_INDEX
INTEGER :: KTS,NTSL
REAL(EB), POINTER, DIMENSION(:,:,:) :: C=>NULL(),B=>NULL(),S=>NULL(),QUANTITY=>NULL()
REAL(FB) :: ZERO,STIME
LOGICAL :: D_FLUX,PLOT3D
LOGICAL :: AGL_TERRAIN_SLICE,CC_SLICE
CHARACTER(1), ALLOCATABLE, DIMENSION(:) :: CVAL

! Return if there are no slices to process and this is not a Plot3D dump
DRY=.FALSE.
PLOT3D = .TRUE.
IF (IFRMT==0) PLOT3D = .FALSE.
 
IF (MESHES(NM)%N_SLCF==0 .AND. .NOT.PLOT3D) RETURN

CALL POINT_TO_MESH(NM)
 
! Set up blockage arrays
 
B => WORK1
B = 0._EB
S => WORK2
S = 0._EB
C => WORK3  
C = 1._EB  ! C is for cell face data (like U, V, W)

! Zero out cell face data for ghost cells at the mesh edges

C(0,0,0:KBP1) = 0._EB
C(0,JBP1,0:KBP1) = 0._EB
C(IBP1,0,0:KBP1) = 0._EB
C(IBP1,JBP1,0:KBP1) = 0._EB
C(0:IBP1,0,0) = 0._EB
C(0:IBP1,0,KBP1) = 0._EB
C(0:IBP1,JBP1,0) = 0._EB
C(0:IBP1,JBP1,KBP1) = 0._EB
C(0,0:JBP1,0) = 0._EB
C(0,0:JBP1,KBP1) = 0._EB
C(IBP1,0:JBP1,0) = 0._EB
C(IBP1,0:JBP1,KBP1) = 0._EB

IF (TWO_D) C(:,   0,:) = 0._EB
IF (TWO_D) C(:,JBP1,:) = 0._EB
 
! Zero out cell center data in all solid cells

DO K=0,KBP1
   DO J=0,JBP1
      DO I=0,IBP1
         IF (.NOT.SOLID(CELL_INDEX(I,J,K))) B(I,J,K) = 1._EB
      ENDDO
   ENDDO
ENDDO
DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         SUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (SUM>0._EB) S(I,J,K) = 1._EB/SUM
      ENDDO
   ENDDO
ENDDO
 
! If sprinkler diagnostic on, pre-compute various droplet flux output

D_FLUX = .FALSE.
IF (.NOT.PLOT3D) THEN
   DO IQ=1,N_SLCF
      SL => SLICE(IQ)
      IF (OUTPUT_QUANTITY(SL%INDEX)%INTEGRATED_DROPLETS) D_FLUX = .TRUE.
   ENDDO
ELSE
   DO IQ=1,5
      IF (OUTPUT_QUANTITY(PLOT3D_QUANTITY_INDEX(IQ))%INTEGRATED_DROPLETS) D_FLUX = .TRUE.
   ENDDO
ENDIF
 
DROPLET_INFO: IF (D_FLUX .AND. .NOT.EVACUATION_ONLY(NM)) THEN
 
   WFX => WORK4 
   WFY => WORK5
   WFZ => WORK6

   WFX = 0._EB
   WFY = 0._EB
   WFZ = 0._EB
 
   DLOOP: DO I=1,NLP
      DR=>DROPLET(I)
      IPC=DR%CLASS
      PC=>PARTICLE_CLASS(IPC)
      IF (DR%X<=XS) CYCLE DLOOP
      IF (DR%X>=XF) CYCLE DLOOP
      IF (DR%Y<=YS) CYCLE DLOOP
      IF (DR%Y>=YF) CYCLE DLOOP
      IF (DR%Z<=ZS) CYCLE DLOOP
      IF (DR%Z>=ZF) CYCLE DLOOP
      XI = CELLSI(NINT((DR%X-XS)*RDXINT))
      YJ = CELLSJ(NINT((DR%Y-YS)*RDYINT))
      ZK = CELLSK(NINT((DR%Z-ZS)*RDZINT))
      II = XI + 1._EB
      JJ = YJ + 1._EB
      KK = ZK + 1._EB
      DROPMASS = DR%PWT*PC%FTPR*DR%R**3
      RVC = RDX(II)*RRN(II)*RDY(JJ)*RDZ(KK)
      WFX(II,JJ,KK) = WFX(II,JJ,KK) + DROPMASS*DR%U*RVC
      WFY(II,JJ,KK) = WFY(II,JJ,KK) + DROPMASS*DR%V*RVC
      WFZ(II,JJ,KK) = WFZ(II,JJ,KK) + DROPMASS*DR%W*RVC
   ENDDO DLOOP
 
   WFX(:,:,0) = WFX(:,:,1)
   WFY(:,:,0) = WFY(:,:,1)
   WFZ(:,:,0) = WFZ(:,:,1)
 
ENDIF DROPLET_INFO
 
! Determine slice or Plot3D indicies
 
QUANTITY=>WORK7
 
IF (PLOT3D) THEN  ! Write out information to .smv file
   TT   = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   ITM  = INT(TT)
   ITM1 = ABS(TT-ITM)*100
   IF (ITM <0 ) THEN
      WRITE(FN_PL3D(NM),'(A,A,I4.4,A1,I8.7,A,I2.2,A2)') TRIM(CHID),'_',NM,'_',ITM,'_',ITM1,'.q'
   ELSE
      WRITE(FN_PL3D(NM),'(A,A,I4.4,A1,I8.8,A,I2.2,A2)') TRIM(CHID),'_',NM,'_',ITM,'_',ITM1,'.q'
   ENDIF
   IF (N_STRINGS+17>N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
      STRING => MESHES(NM)%STRING
   ENDIF
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(A,I5,A,I2.2,I6)')  'PL3D ',ITM,'.',ITM1,NM
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(FN_PL3D(NM))
   DO IQ=1,5
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_BAR_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(PLOT3D_QUANTITY_INDEX(IQ))%UNITS)
   ENDDO
   OPEN(LU_PL3D(NM),FILE=FN_PL3D(NM),FORM='UNFORMATTED',STATUS='REPLACE')
ENDIF

! Loop through all the slice files or the 5 Plot3D quantities

IF (PLOT3D) THEN
   NQT = 5
ELSE
   NQT = N_SLCF
ENDIF
 
NTSL = 0

QUANTITY_LOOP: DO IQ=1,NQT
 
   IF (PLOT3D) THEN
      IND = PLOT3D_QUANTITY_INDEX(IQ)
      SPEC_INDEX = PLOT3D_SPEC_INDEX(IQ)
      PART_INDEX = PLOT3D_PART_INDEX(IQ)
      VELO_INDEX = PLOT3D_VELO_INDEX(IQ)
      I1  = 0
      I2  = IBAR
      J1  = 0
      J2  = JBAR
      K1  = 0
      K2  = KBAR
      AGL_TERRAIN_SLICE = .FALSE.
      CC_SLICE = .FALSE.
   ELSE
      SL => SLICE(IQ)
      IND = SL%INDEX
      SPEC_INDEX = SL%SPEC_INDEX
      PART_INDEX = SL%PART_INDEX
      VELO_INDEX = SL%VELO_INDEX
      I1  = SL%I1
      I2  = SL%I2
      J1  = SL%J1
      J2  = SL%J2
      K1  = SL%K1
      K2  = SL%K2
      AGL_TERRAIN_SLICE = SL%TERRAIN_SLICE
      CC_SLICE = SL%CELL_CENTERED
   ENDIF
 
   ! Determine what cells need to be evaluated to form cell-corner averages
   II1 = I1
   II2 = I2+1
   JJ1 = J1
   JJ2 = J2+1
   KK1 = K1
   KK2 = K2+1
   
   SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
      CASE(CELL_FACE)
         IF (OUTPUT_QUANTITY(IND)%IOR==1) II2 = I2
         IF (OUTPUT_QUANTITY(IND)%IOR==2) JJ2 = J2
         IF (OUTPUT_QUANTITY(IND)%IOR==3) KK2 = K2
      CASE(CELL_EDGE)
         II2 = I2
         JJ2 = J2
         KK2 = K2
   END SELECT
   
   ! Loop through the necessary cells, storing the desired output QUANTITY

   IF (.NOT. AGL_TERRAIN_SLICE) THEN
      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IND,SPEC_INDEX,PART_INDEX,VELO_INDEX,T,NM)
            ENDDO
         ENDDO
      ENDDO
   ELSE
      NTSL = NTSL + 1
      DO I=II1,II2
         DO J=JJ1,JJ2
            DO K=KK1,KK2
               KTS = K_AGL_SLICE(I,J,NTSL) 
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,KTS,IND,SPEC_INDEX,PART_INDEX,VELO_INDEX,T,NM)
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   ! Average the QUANTITY at cell nodes, faces, or edges, as appropriate
   
   IF (PLOT3D) THEN
      IQQ = IQ
   ELSE
      IQQ = 1
   ENDIF

   IF (.NOT. AGL_TERRAIN_SLICE .AND. .NOT. CC_SLICE) THEN
     DO K=K1,K2
        DO J=J1,J2
           DO I=I1,I2
              SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
                 CASE(CELL_CENTER)
                    QQ(I,J,K,IQQ) = CORNER_VALUE(QUANTITY,B,S,IND)
                 CASE(CELL_FACE)
                    QQ(I,J,K,IQQ) = FACE_VALUE(QUANTITY,C,OUTPUT_QUANTITY(IND)%IOR,IND)
                    IC = CELL_INDEX(I,J,K)
                    IF (IC>0) THEN
                       SELECT CASE(IND)
                          CASE(6)
                             IF (UVW_GHOST(IC,1)>-1.E5_EB) QQ(I,J,K,IQQ) = UVW_GHOST(IC,1)
                          CASE(7)
                             IF (UVW_GHOST(IC,2)>-1.E5_EB) QQ(I,J,K,IQQ) = UVW_GHOST(IC,2)
                          CASE(8)
                             IF (UVW_GHOST(IC,3)>-1.E5_EB) QQ(I,J,K,IQQ) = UVW_GHOST(IC,3)
                       END SELECT
                    ENDIF
                 CASE(CELL_EDGE)
                    QQ(I,J,K,IQQ) = EDGE_VALUE(QUANTITY,S,IND)
              END SELECT
           ENDDO
        ENDDO
     ENDDO
   ENDIF

   ! Special terrain-following slice

   IF (AGL_TERRAIN_SLICE .OR. CC_SLICE) THEN
      DO K=K1,K2
         DO J=J1,J2
            DO I=I1,I2
               QQ(I,J,K,IQQ) = QUANTITY(I,J,K)
            ENDDO
         ENDDO
      ENDDO
   ENDIF
 
   ! Dump out the slice file to a .sf file
 
   IF (.NOT.PLOT3D) THEN
      SL => SLICE(IQ)
      STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
      IF (.NOT.SL%RLE .AND. .NOT. SL%TWO_BYTE) THEN
         WRITE(LU_SLCF(IQ,NM)) STIME
         WRITE(LU_SLCF(IQ,NM)) (((QQ(I,J,K,1),I=I1,I2),J=J1,J2),K=K1,K2)
      ENDIF
      IF (SL%TWO_BYTE) THEN
         WRITE(LU_SLCF(IQ,NM)) STIME
         WRITE(LU_SLCF(IQ,NM)) (((TWO_BYTE_REAL(QQ(I,J,K,1)),I=I1,I2),J=J1,J2),K=K1,K2)
      ENDIF 
      IF (SL%RLE) THEN
         NQ   = (I2-I1+1)*(J2-J1+1)*(K2-K1+1)
         ALLOCATE(CVAL(NQ))
         NRLE = RLE_COMPRESSION(QQ(I1:I2,J1:J2,K1:K2,1),NQ,SL%MINMAX(1),SL%MINMAX(2),CVAL)
         WRITE(LU_SLCF(IQ,NM)) STIME
         WRITE(LU_SLCF(IQ,NM)) NRLE
         WRITE(LU_SLCF(IQ,NM)) (CVAL(I),I=1,NRLE)
         DEALLOCATE(CVAL)
      ENDIF
   ENDIF
 
ENDDO QUANTITY_LOOP
 
! Write out the PLOT3D ``q'' file
 
IF (PLOT3D) THEN
   ZERO = 0._EB
   WRITE(LU_PL3D(NM)) IBP1,JBP1,KBP1
   WRITE(LU_PL3D(NM)) ZERO,ZERO,ZERO,ZERO
   WRITE(LU_PL3D(NM)) ((((QQ(I,J,K,IQ),I=0,IBAR),J=0,JBAR),K=0,KBAR),IQ=1,5)
   CLOSE(LU_PL3D(NM))
ENDIF
 
CONTAINS
 
 
REAL(EB) FUNCTION CORNER_VALUE(A,B,S,INDX)
 
REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,B,S
INTEGER, INTENT(IN) :: INDX

IF (S(I,J,K)==0._EB) THEN
   CORNER_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   CORNER_VALUE = S(I,J,K)*(A(I,J,K)    *B(I,J,K)     + A(I+1,J,K)    *B(I+1,J,K)   + &
                            A(I,J,K+1)  *B(I,J,K+1)   + A(I+1,J,K+1)  *B(I+1,J,K+1) + &
                            A(I,J+1,K)  *B(I,J+1,K)   + A(I+1,J+1,K)  *B(I+1,J+1,K) + &
                            A(I,J+1,K+1)*B(I,J+1,K+1) + A(I+1,J+1,K+1)*B(I+1,J+1,K+1))
ENDIF
 
END FUNCTION CORNER_VALUE
 
 
REAL(EB) FUNCTION FACE_VALUE(A,C,IOR,INDX)
 
REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,C
INTEGER, INTENT(IN) :: IOR,INDX
REAL(EB) :: SUM

SELECT CASE(IOR)
   CASE(1)
      SUM = C(I,J,K)+C(I,J,K+1)+C(I,J+1,K)+C(I,J+1,K+1)
      IF (SUM==0._EB) THEN
         FACE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
      ELSE
         FACE_VALUE = ( A(I,J,K)  *C(I,J,K)   + A(I,J,K+1)  *C(I,J,K+1) + &
                        A(I,J+1,K)*C(I,J+1,K) + A(I,J+1,K+1)*C(I,J+1,K+1) )/SUM
      ENDIF
   CASE(2)
      SUM = C(I,J,K)+C(I,J,K+1)+C(I+1,J,K)+C(I+1,J,K+1)
      IF (SUM==0._EB) THEN
         FACE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
      ELSE
         FACE_VALUE = ( A(I,J,K)  *C(I,J,K)   + A(I,J,K+1)  *C(I,J,K+1) + &
                        A(I+1,J,K)*C(I+1,J,K) + A(I+1,J,K+1)*C(I+1,J,K+1) )/SUM
      ENDIF
   CASE(3)
      SUM = C(I,J,K)+C(I+1,J,K)+C(I,J+1,K)+C(I+1,J+1,K)
      IF (SUM==0._EB) THEN
         FACE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
      ELSE
         FACE_VALUE = ( A(I,J,K)  *C(I,J,K)   + A(I+1,J,K)  *C(I+1,J,K) + &
                        A(I,J+1,K)*C(I,J+1,K) + A(I+1,J+1,K)*C(I+1,J+1,K) )/SUM
      ENDIF
END SELECT
 
END FUNCTION FACE_VALUE

REAL(EB) FUNCTION EDGE_VALUE(A,S,INDX)
 
REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,S
INTEGER, INTENT(IN) :: INDX

IF (S(I,J,K)==0._EB) THEN
   EDGE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   EDGE_VALUE = A(I,J,K)
ENDIF
  
END FUNCTION EDGE_VALUE

END SUBROUTINE DUMP_SLCF
 

 
SUBROUTINE UPDATE_DEVICES(T,NM)

! Update the value of all sensing DEVICEs,any control function outputs, and associated output quantities

USE MEMORY_FUNCTIONS, ONLY : RE_ALLOCATE_STRINGS
USE EVAC, ONLY: N_DOORS, N_EXITS, N_ENTRYS, EVAC_DOORS, EVAC_EXITS, EVAC_ENTRYS, EVAC_EXIT_TYPE, EVAC_DOOR_TYPE, EVAC_ENTR_TYPE
REAL(EB), INTENT(IN) :: T
REAL(EB) :: VALUE,STAT_VALUE,SUM_VALUE,VOL,WGT
INTEGER :: NM,N,I,J,K,STAT_COUNT,IW,IBC,I_STATE
LOGICAL :: NOT_FOUND
 
CALL POINT_TO_MESH(NM)

! Weighting factor for running average of line devices

WGT = DT/(MIN(MAX(DT,T-T_BEGIN),DT_DEVC_LINE))

! Loop over all devices and determine its current VALUE

DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)
   IF (DV%MESH/=NM) CYCLE DEVICE_LOOP
   DRY = DV%DRY
   PY => PROPERTY(DV%PROP_INDEX)

   ! Reset state variables so that if a change occurs due to a setpoint being reached, action can be taken

   DV%PRIOR_STATE = DV%CURRENT_STATE
 
   ! Initial values for statistics

   NOT_FOUND  = .TRUE.
   STAT_COUNT =  0
   SUM_VALUE = 0._EB
   SELECT CASE(DV%STATISTICS)
      CASE('MAX')
         STAT_VALUE = -HUGE(0.0_EB) + 1.0_EB
      CASE('MIN')
         STAT_VALUE =  HUGE(0.0_EB) - 1.0_EB
      CASE DEFAULT
         STAT_VALUE =  0.0_EB
   END SELECT

   ! Select either gas or solid phase output quantity

   GAS_OR_SOLID_PHASE: IF (DV%OUTPUT_INDEX>0) THEN 
      GAS_OR_HVAC: IF (DV%OUTPUT_INDEX >= 300) THEN
      
         VALUE = HVAC_OUTPUT(DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX)
      
      ELSE GAS_OR_HVAC

         GAS_STATS: IF (DV%STATISTICS=='null') THEN

            VALUE = GAS_PHASE_OUTPUT(DV%I,DV%J,DV%K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)

         ELSEIF (DV%STATISTICS=='TIME INTEGRAL') THEN GAS_STATS
            VALUE = DV%TI_VALUE + (T-DV%TI_T)* &
                                 GAS_PHASE_OUTPUT(DV%I,DV%J,DV%K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
            DV%TI_VALUE = VALUE
            DV%TI_T = T

         ELSE GAS_STATS

            DO K=DV%K1,DV%K2
               DO J=DV%J1,DV%J2
                  DO I=DV%I1,DV%I2
                     IF (SOLID(CELL_INDEX(I,J,K))) CYCLE
                     VOL = DX(I)*RC(I)*DY(J)*DZ(K)
                     NOT_FOUND = .FALSE.
                     SELECT CASE(DV%STATISTICS)
                        CASE('MAX')
                           STAT_VALUE = MAX(STAT_VALUE, &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM))
                        CASE('MIN')
                           STAT_VALUE = MIN(STAT_VALUE, &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM))
                        CASE('MEAN')
                           STAT_VALUE = STAT_VALUE + &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
                           STAT_COUNT = STAT_COUNT + 1
                        CASE('VOLUME INTEGRAL')
                           STAT_VALUE = STAT_VALUE + &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)*VOL
                        CASE('MASS INTEGRAL')
                           STAT_VALUE = STAT_VALUE + &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)* &
                                       VOL*RHO(I,J,K)
                        CASE('AREA INTEGRAL')
                           IF (DV%IOR==1) STAT_VALUE = STAT_VALUE + RC(I)*DY(J)*DZ(K)* &
                                          GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
                           IF (DV%IOR==2) STAT_VALUE = STAT_VALUE + DX(I)*DZ(K)* &
                                          GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
                           IF (DV%IOR==3) STAT_VALUE = STAT_VALUE + DX(I)*RC(I)*DY(J)* &
                                          GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
                        CASE('VOLUME MEAN')
                           STAT_VALUE = STAT_VALUE + &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)*VOL
                           SUM_VALUE = SUM_VALUE + VOL
                        CASE('MASS MEAN')
                           STAT_VALUE = STAT_VALUE + VOL*RHO(I,J,K)* &
                                       GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,DV%SPEC_INDEX,DV%PART_INDEX,DV%VELO_INDEX,T,NM)
                           SUM_VALUE = SUM_VALUE + VOL*RHO(I,J,K)
                     END SELECT
                  ENDDO
               ENDDO
            ENDDO

         ENDIF GAS_STATS
      ENDIF GAS_OR_HVAC

   ELSE GAS_OR_SOLID_PHASE            

      SOLID_STATS: IF (DV%STATISTICS=='null') THEN

         VALUE = SOLID_PHASE_OUTPUT(NM,DV%IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX)

      ELSEIF (DV%STATISTICS=='TIME INTEGRAL') THEN SOLID_STATS

         VALUE = DV%TI_VALUE + (T-DV%TI_T)*SOLID_PHASE_OUTPUT(NM,DV%IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX)
         DV%TI_VALUE = VALUE
         DV%TI_T = T

      ELSE SOLID_STATS

         WALL_CELL_LOOP: DO IW=1,NWC
            IF (BOUNDARY_TYPE(IW)/=SOLID_BOUNDARY) CYCLE WALL_CELL_LOOP
            IF (XW(IW)<DV%X1 .OR. XW(IW)>DV%X2 .OR. &
                YW(IW)<DV%Y1 .OR. YW(IW)>DV%Y2 .OR. &
                ZW(IW)<DV%Z1 .OR. ZW(IW)>DV%Z2) CYCLE WALL_CELL_LOOP
            IBC = IJKW(5,IW)
            IF (DV%SURF_ID=='null' .OR. SURFACE(IBC)%ID==DV%SURF_ID) THEN
               NOT_FOUND = .FALSE.
               SELECT CASE(DV%STATISTICS)
                  CASE('MAX')
                     STAT_VALUE = MAX(STAT_VALUE,SOLID_PHASE_OUTPUT(NM,IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX))
                  CASE('MIN')
                     STAT_VALUE = MIN(STAT_VALUE,SOLID_PHASE_OUTPUT(NM,IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX))
                  CASE('MEAN')
                     STAT_VALUE = STAT_VALUE + SOLID_PHASE_OUTPUT(NM,IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX)
                     STAT_COUNT = STAT_COUNT + 1
                  CASE('SURFACE INTEGRAL')
                     STAT_VALUE = STAT_VALUE + SOLID_PHASE_OUTPUT(NM,IW,ABS(DV%OUTPUT_INDEX),DV%SPEC_INDEX,DV%PART_INDEX)*AW(IW) 
               END SELECT
            ENDIF
         ENDDO WALL_CELL_LOOP

      ENDIF SOLID_STATS

   ENDIF GAS_OR_SOLID_PHASE

   ! Update DEViCe values

   SELECT CASE (DV%STATISTICS)
      CASE('null')
      CASE('TIME INTEGRAL')
      CASE('MASS MEAN','VOLUME MEAN')
         VALUE = STAT_VALUE / SUM_VALUE
      CASE DEFAULT
         IF (NOT_FOUND) STAT_VALUE = 0._EB
         STAT_COUNT = MAX(STAT_COUNT,1)
         VALUE = STAT_VALUE/REAL(STAT_COUNT,EB)
   END SELECT

   ! Convert units of device quantity

   VALUE = DV%CONVERSION_FACTOR*VALUE

   ! Update the running average and/or instantaneous device value

   DV%INSTANT_VALUE = VALUE

   IF (DV%LINE>0) THEN
      DV%TIME_INTERVAL = 1._EB
      DV%VALUE = (1._EB-WGT)*DV%VALUE + WGT*VALUE
   ELSEIF (DV%TIME_AVERAGED .AND. OUTPUT_QUANTITY(DV%OUTPUT_INDEX)%TIME_AVERAGED) THEN
      DV%TIME_INTERVAL = DV%TIME_INTERVAL + DT
      DV%VALUE = DV%VALUE + VALUE*DT
   ELSE
      DV%TIME_INTERVAL = 1._EB
      DV%VALUE = VALUE
   ENDIF
   
   ! Check for change in control function output of device

   LATCHIF: IF (DV%LATCH) THEN
      IF (DV%INITIAL_STATE .EQV. DV%CURRENT_STATE) THEN
         DEVICE_DIRECTION: IF (DV%TRIP_DIRECTION > 0) THEN
            IF (VALUE > DV%SETPOINT) DV%CURRENT_STATE = .NOT. DV%INITIAL_STATE
         ELSE DEVICE_DIRECTION
            IF (VALUE < DV%SETPOINT) DV%CURRENT_STATE = .NOT. DV%INITIAL_STATE
         ENDIF DEVICE_DIRECTION
      ENDIF
   ELSE LATCHIF
      DEVICE_DIRECTION2: IF (DV%TRIP_DIRECTION > 0) THEN
         IF ((VALUE > DV%SETPOINT) .AND. (DV%CURRENT_STATE .EQV. DV%INITIAL_STATE)) THEN
            DV%CURRENT_STATE = .NOT. DV%INITIAL_STATE
         ELSEIF ((VALUE < DV%SETPOINT) .AND. (DV%CURRENT_STATE .NEQV. DV%INITIAL_STATE)) THEN
            DV%CURRENT_STATE = DV%INITIAL_STATE
         ENDIF
      ELSE DEVICE_DIRECTION2
         IF (VALUE < DV%SETPOINT .AND. DV%CURRENT_STATE .EQV. DV%INITIAL_STATE) THEN
            DV%CURRENT_STATE = .NOT. DV%INITIAL_STATE
         ELSEIF (VALUE > DV%SETPOINT .AND. DV%CURRENT_STATE .NEQV. DV%INITIAL_STATE) THEN
            DV%CURRENT_STATE = DV%INITIAL_STATE
         ENDIF
      ENDIF DEVICE_DIRECTION2
   ENDIF LATCHIF
   
   ! If a DEViCe changes state, save the Smokeview file strings and time of state change

   IF (DV%CURRENT_STATE .NEQV. DV%PRIOR_STATE) THEN
      DV%T_CHANGE = T
      M=>MESHES(NM)
      IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
         CALL RE_ALLOCATE_STRINGS(NM)
      ENDIF
      I_STATE=0
      IF (DV%CURRENT_STATE) I_STATE=1
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(A,5X,A,1X)') 'DEVICE_ACT',TRIM(DV%ID)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(I6,F10.2,I6)') N,T,I_STATE
   ENDIF

!Write initial state of DEViCes to the Smokeview file

   IF (T==T_BEGIN .AND. .NOT. DV%CURRENT_STATE) THEN
      M=>MESHES(NM)
      IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
         CALL RE_ALLOCATE_STRINGS(NM)
      ENDIF
      I_STATE=0
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(A,5X,A,1X)') 'DEVICE_ACT',TRIM(DV%ID)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(I6,F10.2,I6)') N,T,I_STATE
   ENDIF

ENDDO DEVICE_LOOP

! Write the initial states of the evacuation devices (exit,door,entr)

EVAC_ONLY6: IF (EVACUATION_GRID(NM)) THEN
!  EVAC_ONLY6: IF (EVACUATION_GRID(NM) .AND. T==T_BEGIN) THEN
   I=0  ! Counter for evacuation devices, doors+exits+entrys (evss do not change states)
   DO N=1,N_DOORS
      IF (.NOT.EVAC_DOORS(N)%SHOW) CYCLE
      I=I+1
      IF (EVAC_DOORS(N)%IMODE>0 .AND. EVAC_DOORS(N)%IMESH==NM) THEN
         EVAC_DOORS(N)%IMODE=-EVAC_DOORS(N)%IMODE   ! +: change status, -: has already changed status
         M=>MESHES(NM)
         IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
            CALL RE_ALLOCATE_STRINGS(NM)
         ENDIF
         I_STATE=ABS(EVAC_DOORS(N)%IMODE)-1
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,5X,A,1X)') 'DEVICE_ACT',TRIM(EVAC_DOORS(N)%ID)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I6,F10.2,I6)') I+N_DEVC,T,I_STATE
      ENDIF
   ENDDO
   DO N=1,N_EXITS
      IF (EVAC_EXITS(N)%COUNT_ONLY .OR. .NOT.EVAC_EXITS(N)%SHOW) CYCLE
      I=I+1
      IF (EVAC_EXITS(N)%IMODE>0 .AND. EVAC_EXITS(N)%IMESH==NM) THEN
         EVAC_EXITS(N)%IMODE=-EVAC_EXITS(N)%IMODE   ! +: change status, -: has already changed status
         M=>MESHES(NM)
         IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
            CALL RE_ALLOCATE_STRINGS(NM)
         ENDIF
         I_STATE=ABS(EVAC_EXITS(N)%IMODE)-1
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,5X,A,1X)') 'DEVICE_ACT',TRIM(EVAC_EXITS(N)%ID)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I6,F10.2,I6)') I+N_DEVC,T,I_STATE
      ENDIF
   ENDDO
   DO N=1,N_ENTRYS
      IF (EVAC_ENTRYS(N)%SHOW) CYCLE
      I=I+1
      IF (EVAC_ENTRYS(N)%IMODE>0 .AND. EVAC_ENTRYS(N)%IMESH==NM) THEN
         EVAC_ENTRYS(N)%IMODE=-EVAC_ENTRYS(N)%IMODE   ! +: change status, -: has already changed status
         M=>MESHES(NM)
         IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
            CALL RE_ALLOCATE_STRINGS(NM)
         ENDIF
         I_STATE=ABS(EVAC_ENTRYS(N)%IMODE)-1
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,5X,A,1X)') 'DEVICE_ACT',TRIM(EVAC_ENTRYS(N)%ID)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I6,F10.2,I6)') I+N_DEVC,T,I_STATE
      ENDIF
   ENDDO
ENDIF EVAC_ONLY6

END SUBROUTINE UPDATE_DEVICES
 


REAL(EB) FUNCTION GAS_PHASE_OUTPUT(II,JJ,KK,IND,SPEC_INDEX,PART_INDEX,VELO_INDEX,T,NM)

! Compute Gas Phase Output Quantities

USE MEMORY_FUNCTIONS, ONLY: REALLOCATE
USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D,EVALUATE_RAMP
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION, FED,GET_SPECIFIC_HEAT,GET_AVERAGE_SPECIFIC_HEAT, &
                              GET_CONDUCTIVITY,GET_MOLECULAR_WEIGHT
USE CONTROL_VARIABLES, ONLY: CONTROL
REAL(EB), INTENT(IN) :: T
INTEGER, INTENT(IN) :: II,JJ,KK,IND,NM,VELO_INDEX
REAL(EB) :: FLOW,HMFAC,F1,F2,H_TC,SRAD,TMP_TC,MU_AIR,RE_D,K_AIR,NUSSELT,NU_FAC,PR,AREA,VEL, &
            Q_SUM,TMP_G,UU,VV,WW,VEL2,Y_MF_INT,DENS,EXT_COEF,MASS_EXT_COEF,UIIINT, &
            VELSR,WATER_VOL_FRAC,RHS,Y_E,DT_C,DT_E,T_RATIO,Y_E_LAG, H_G,H_G_SUM,CP,YY_GET(1:N_SPECIES), &
            DHOR,X_EQUIL,MW_RATIO,Y_EQUIL,TMP_BOIL,EXPON,Y_SPECIES,MEC,Y_SPECIES2,Y_H2O,R_Y_H2O,YY_G(1:N_SPECIES),R_DN,SGN
REAL(FB) :: TMPUP,TMPLOW,ZINT
INTEGER :: ITER,N,I,J,K,NN,IL,III,JJJ,KKK,IPC,IW,SPEC_INDEX,PART_INDEX,ITMP,IP,JP,KP
CHARACTER(100) :: MESSAGE

! Get species mass fraction if necessary

IF (SPEC_INDEX<0) THEN
   YY_GET(:) = YY(II,JJ,KK,:)
   CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES)
   Y_H2O = 0._EB
   R_Y_H2O = 0._EB
   IF (DRY .AND. H2O_INDEX > 0) THEN
      CALL GET_MASS_FRACTION(YY_GET,H2O_INDEX,Y_H2O)
      R_Y_H2O = RCON_MF(H2O_INDEX) * Y_H2O
      IF (-SPEC_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ELSEIF (SPEC_INDEX>0) THEN
   Y_SPECIES=YY(II,JJ,KK,SPEC_INDEX)
ELSE
   Y_SPECIES=1.0_EB
ENDIF

! Get desired output value

SELECT CASE(IND)
   CASE DEFAULT  ! SMOKE/WATER
      GAS_PHASE_OUTPUT = 0._EB
   CASE( 1)  ! DENSITY
      IF (SPEC_INDEX/=0) THEN
         GAS_PHASE_OUTPUT = RHO(II,JJ,KK)*Y_SPECIES
      ELSE
         GAS_PHASE_OUTPUT = RHO(II,JJ,KK)
      ENDIF
   CASE( 2)  ! F_X
      GAS_PHASE_OUTPUT = FVX(II,JJ,KK)
   CASE( 3)  ! F_Y
      GAS_PHASE_OUTPUT = FVY(II,JJ,KK)
   CASE( 4)  ! F_Z
      GAS_PHASE_OUTPUT = FVZ(II,JJ,KK)
   CASE( 5)  ! TEMPERATURE
      GAS_PHASE_OUTPUT = TMP(II,JJ,KK) - TMPM
   CASE( 6)  ! U-VELOCITY
      GAS_PHASE_OUTPUT = U(II,JJ,KK)
   CASE( 7)  ! V-VELOCITY
      GAS_PHASE_OUTPUT = V(II,JJ,KK)
   CASE( 8)  ! W-VELOCITY
      GAS_PHASE_OUTPUT = W(II,JJ,KK)
   CASE( 9)  ! PRESSURE
      UU   = 0.5_EB*(U(MIN(IBAR,II),JJ,KK)+U(MAX(0,II-1),JJ,KK))
      VV   = 0.5_EB*(V(II,MIN(JBAR,JJ),KK)+V(II,MAX(0,JJ-1),KK))
      WW   = 0.5_EB*(W(II,JJ,MIN(KBAR,KK))+W(II,JJ,MAX(0,KK-1)))
      VEL2 = UU**2+VV**2+WW**2
      GAS_PHASE_OUTPUT  = PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + RHO(II,JJ,KK)*(H(II,JJ,KK)-.5_EB*VEL2) - P_0(KK)
   CASE(10)  ! VELOCITY
      UU   = 0.5_EB*(U(MIN(IBAR,II),JJ,KK)+U(MAX(0,II-1),JJ,KK))
      VV   = 0.5_EB*(V(II,MIN(JBAR,JJ),KK)+V(II,MAX(0,JJ-1),KK))
      WW   = 0.5_EB*(W(II,JJ,MIN(KBAR,KK))+W(II,JJ,MAX(0,KK-1)))
      SELECT CASE(ABS(VELO_INDEX))
         CASE DEFAULT
            SGN = 1._EB
         CASE(1)
            SGN = SIGN(1._EB,UU)*SIGN(1,VELO_INDEX)
         CASE(2)
            SGN = SIGN(1._EB,VV)*SIGN(1,VELO_INDEX)
         CASE(3)
            SGN = SIGN(1._EB,WW)*SIGN(1,VELO_INDEX)
      END SELECT
      VEL2 = UU**2+VV**2+WW**2
      GAS_PHASE_OUTPUT  = SGN*SQRT(VEL2)
   CASE(11)  ! HRRPUV
      GAS_PHASE_OUTPUT = Q(II,JJ,KK)*0.001_EB
   CASE(12)  ! H
      GAS_PHASE_OUTPUT = H(II,JJ,KK)
   CASE(13)  ! MIXTURE FRACTION
      GAS_PHASE_OUTPUT = SUM(YY(II,JJ,KK,I_Z_MIN:I_Z_MAX))
   CASE(14)  ! DIVERGENCE
      GAS_PHASE_OUTPUT = D(II,JJ,KK)
   CASE(15)  ! MIXING TIME
      GAS_PHASE_OUTPUT = MAX(DT,C_EDC*SC*RHO(II,JJ,KK)*(DX(II)*DY(JJ)*DZ(KK))**TWTH/MU(II,JJ,KK))
   CASE(16)  ! ABSORPTION COEFFICIENT
      GAS_PHASE_OUTPUT = KAPPA(II,JJ,KK)
   CASE(17)  ! VISCOSITY
      GAS_PHASE_OUTPUT = MU(II,JJ,KK)
   CASE(18)  ! INTEGRATED INTENSITY
      GAS_PHASE_OUTPUT = UII(II,JJ,KK)*0.001_EB
   CASE(19)  ! RADIATION LOSS
      GAS_PHASE_OUTPUT = QR(II,JJ,KK)*0.001_EB
   CASE(20)  ! PARTICLE RADIATION LOSS
      GAS_PHASE_OUTPUT = QR_W(II,JJ,KK)*0.001_EB
   CASE(21)  ! RELATIVE HUMIDITY
      TMP_BOIL = 373.15_EB
      IF (WATER_PART_INDEX > 0) THEN
         DHOR = PARTICLE_CLASS(WATER_PART_INDEX)%H_V(NINT(MIN(5000._EB,TMP(II,JJ,KK))))*MW_H2O/R0
      ELSE
         DHOR = (3023410.8_EB-MAX(MIN(TMP(II,JJ,KK),TMP_BOIL),273.15_EB)*2334.894_EB)*MW_H2O/R0 !linear fit of JANAF table
      ENDIF
      X_EQUIL  = MIN(1._EB,EXP(DHOR*(1._EB/TMP_BOIL-1._EB/MIN(TMP(II,JJ,KK),TMP_BOIL))))
      Y_MF_INT=0._EB
      IF (MIXTURE_FRACTION) THEN
         YY_GET(:) = YY(II,JJ,KK,:)
         CALL GET_MASS_FRACTION(YY_GET,H2O_INDEX,Y_MF_INT)
      ELSE
         IF (I_WATER > 0) Y_MF_INT = YY(II,JJ,KK,I_WATER)
      ENDIF
      MW_RATIO = SPECIES(0)%MW/MW_H2O
      Y_EQUIL = X_EQUIL/(MW_RATIO + (1._EB-MW_RATIO)*X_EQUIL)
      GAS_PHASE_OUTPUT = Y_MF_INT/Y_EQUIL * 100._EB      
      
   CASE(23)  ! KINETIC ENERGY (per unit mass) -- do not average because this operation is dissipative
      UU   = U(MIN(IBAR,II),JJ,KK)
      VV   = V(II,MIN(JBAR,JJ),KK)
      WW   = W(II,JJ,MIN(KBAR,KK))
      GAS_PHASE_OUTPUT  = 0.5_EB*( UU**2 + VV**2 + WW**2 )
      
   CASE(24)  ! STRAIN RATE X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) + (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(25)  ! STRAIN RATE Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) + (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(26)  ! STRAIN RATE Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) + (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)
   CASE(27)  ! VORTICITY X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) - (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(28)  ! VORTICITY Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) - (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(29)  ! VORTICITY Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) - (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)
      
   CASE(30)  ! DYNAMIC SMAGORINSKY COEFFICIENT
      IF (.NOT.DYNSMAG) THEN
         WRITE(MESSAGE,'(A)') "ERROR: Cannot DUMP C_DYNSMAG, DYNSMAG=.FALSE."
         CALL SHUTDOWN(MESSAGE)
      ENDIF
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT = C_DYNSMAG(III,JJJ,KKK) 
      
   CASE(31)  ! SPECIFIC HEAT
      ITMP = MIN(5000,NINT(TMP(II,JJ,KK)))
      IF (N_SPECIES>0) THEN
         YY_GET(:) = YY(II,JJ,KK,:)
         CALL GET_SPECIFIC_HEAT(YY_GET,CP,ITMP)
      ELSE
         CP = Y2CP_C(ITMP)
      ENDIF
      GAS_PHASE_OUTPUT = CP*0.001_EB

   CASE(32)  ! HRRPUA
      GAS_PHASE_OUTPUT = Q(II,JJ,KK)*0.001_EB*(DX(II)*DY(JJ)*DZ(KK))**ONTH
   CASE(33)  ! CONDUCTIVITY
      ITMP = MIN(5000,NINT(TMP(II,JJ,KK)))
      IF (DNS) THEN
         IF (N_SPECIES > 0 ) THEN
            YY_GET(:) = YY(II,JJ,KK,:)
            CALL GET_CONDUCTIVITY(YY_GET,GAS_PHASE_OUTPUT ,ITMP)     
         ELSE
            GAS_PHASE_OUTPUT  = Y2K_C(ITMP)*SPECIES(0)%MW
         ENDIF
      ELSE
         GAS_PHASE_OUTPUT  = MU(II,JJ,KK)*CPOPR
      ENDIF
            
   CASE(40)  ! MOLECULAR WEIGHT
      IF (N_SPECIES>0) THEN
         YY_GET(:) = YY(II,JJ,KK,:)
         CALL GET_MOLECULAR_WEIGHT(YY_GET,GAS_PHASE_OUTPUT)
      ELSE
         GAS_PHASE_OUTPUT = SPECIES(0)%MW
      ENDIF
   CASE(41)  ! TIME
      GAS_PHASE_OUTPUT = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   CASE(42)  ! TIME STEP
      GAS_PHASE_OUTPUT = DT
   CASE(43)  ! WALL CLOCK TIME
      GAS_PHASE_OUTPUT = WALL_CLOCK_TIME() - WALL_CLOCK_START
   CASE(44)  ! CPU TIME
      GAS_PHASE_OUTPUT = SECOND() - TUSED(1,NM)
   CASE(45)  ! ITERATION
      GAS_PHASE_OUTPUT = ICYC
      
   CASE(46:48)  ! SPECIFIC ENTHALPY and ENTHALPY and AVERAGE SPECIFIC HEAT
      ITMP = MIN(5000,NINT(TMP(II,JJ,KK)))
      IF (N_SPECIES>0) THEN
         YY_GET(:) = YY(II,JJ,KK,:)
         CALL GET_AVERAGE_SPECIFIC_HEAT(YY_GET,CP,ITMP)
      ELSE
         CP = Y2CPBAR_C(ITMP)
      ENDIF
      GAS_PHASE_OUTPUT = CP*0.001_EB
      IF (IND <48) GAS_PHASE_OUTPUT = GAS_PHASE_OUTPUT * TMP(II,JJ,KK)
      IF (IND==47) GAS_PHASE_OUTPUT = GAS_PHASE_OUTPUT * RHO(II,JJ,KK)

   CASE(50)  ! MTR (measure of turbulence resolution)
      IF (.NOT.CHECK_KINETIC_ENERGY) THEN
         WRITE(MESSAGE,'(A)') "ERROR: Cannot DUMP MTR, CHECK_KINETIC_ENERGY=.FALSE."
         CALL SHUTDOWN(MESSAGE)
      ENDIF
      GAS_PHASE_OUTPUT = MTR(II,JJ,KK)
   CASE(51)  ! MSR (measure of scalar resolution)
      IF (.NOT.CHECK_KINETIC_ENERGY) THEN
         WRITE(MESSAGE,'(A)') "ERROR: Cannot DUMP MSR, CHECK_KINETIC_ENERGY=.FALSE."
         CALL SHUTDOWN(MESSAGE)
      ENDIF
      IF (N_SPECIES>0) GAS_PHASE_OUTPUT = MSR(II,JJ,KK)
   CASE(52)  ! WEM (wavelet error measure)
      IF (.NOT.CHECK_KINETIC_ENERGY) THEN
         WRITE(MESSAGE,'(A)') "ERROR: Cannot DUMP WEM, CHECK_KINETIC_ENERGY=.FALSE."
         CALL SHUTDOWN(MESSAGE)
      ENDIF
      GAS_PHASE_OUTPUT = WEM(II,JJ,KK)
   CASE(53)  ! CELL-CENTERED VELOCITY COMPONENTS
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT = IBM_SAVE3(III,JJJ,KKK) !UBAR
   
   CASE(55)  ! MAXIMUM VELOCITY ERROR
      GAS_PHASE_OUTPUT = MAXVAL(VELOCITY_ERROR_MAX)

   CASE(56)  ! PRESSURE ITERATIONS
      GAS_PHASE_OUTPUT = PRESSURE_ITERATIONS

   CASE(59)  ! OPEN NOZZLES
      GAS_PHASE_OUTPUT = N_OPEN_NOZZLES

   CASE(60)  ! ACTUATED SPRINKLERS
      GAS_PHASE_OUTPUT = N_ACTUATED_SPRINKLERS

   CASE(90)  ! MASS FRACTION
      IF (SPEC_INDEX<0) THEN
         GAS_PHASE_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ENDIF
      IF (SPEC_INDEX>0) GAS_PHASE_OUTPUT = Y_SPECIES
   CASE(91)  ! MASS FLUX X
      IF (SPEC_INDEX<0) THEN
         YY_GET(:) = YY(II+1,JJ,KK,:)
         CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES2)
      ENDIF
      IF (SPEC_INDEX>0) Y_SPECIES2 = YY(II+1,JJ,KK,SPEC_INDEX)
      GAS_PHASE_OUTPUT = 0.5_EB*(RHO(II,JJ,KK)*Y_SPECIES+RHO(II+1,JJ,KK)*Y_SPECIES2)*U(II,JJ,KK)
   CASE(92)  ! MASS FLUX Y
      IF (SPEC_INDEX<0) THEN
         YY_GET(:) = YY(II,JJ+1,KK,:)
         CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES2)
      ENDIF
      IF (SPEC_INDEX>0) Y_SPECIES2 = YY(II,JJ+1,KK,SPEC_INDEX)
      GAS_PHASE_OUTPUT = 0.5_EB*(RHO(II,JJ,KK)*Y_SPECIES+RHO(II,JJ+1,KK)*Y_SPECIES2)*V(II,JJ,KK)
   CASE(93)  ! MASS FLUX Z
      IF (SPEC_INDEX<0) THEN
         YY_GET(:) = YY(II,JJ,KK+1,:)
         CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES2)
      ENDIF
      IF (SPEC_INDEX>0) Y_SPECIES2 = YY(II,JJ,KK+1,SPEC_INDEX)
      GAS_PHASE_OUTPUT = 0.5_EB*(RHO(II,JJ,KK)*Y_SPECIES+RHO(II,JJ,KK+1)*Y_SPECIES2)*W(II,JJ,KK)
   CASE(94)  ! VOLUME FRACTION
      IF (SPEC_INDEX<0) THEN
         GAS_PHASE_OUTPUT = RCON_MF(-SPEC_INDEX)*Y_SPECIES/RSUM(II,JJ,KK)/(1._EB-R_Y_H2O/RSUM(II,JJ,KK))
      ELSEIF (SPEC_INDEX>0) THEN
         GAS_PHASE_OUTPUT = SPECIES(SPEC_INDEX)%RCON*Y_SPECIES/RSUM(II,JJ,KK)
      ENDIF
   CASE(95)  ! VISIBILITY
      IF (SPEC_INDEX>0) MEC = SPECIES(SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
      IF (SPEC_INDEX<0) MEC = MASS_EXTINCTION_COEFFICIENT
      EXT_COEF = Y_SPECIES*RHO(II,JJ,KK)*MEC
      GAS_PHASE_OUTPUT = VISIBILITY_FACTOR/MAX(EC_LL,EXT_COEF)
   CASE(96)  ! SOOT VOLUME FRACTION
      GAS_PHASE_OUTPUT = Y_SPECIES*RHO(II,JJ,KK)/RHO_SOOT
   CASE(97)  ! EXTINCTION COEFFICIENT
      IF (SPEC_INDEX>0) MEC = SPECIES(SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
      IF (SPEC_INDEX<0) MEC = MASS_EXTINCTION_COEFFICIENT
      GAS_PHASE_OUTPUT = Y_SPECIES*RHO(II,JJ,KK)*MEC
   CASE(98)  ! OPTICAL DENSITY
      IF (SPEC_INDEX>0) MEC = SPECIES(SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
      IF (SPEC_INDEX<0) MEC = MASS_EXTINCTION_COEFFICIENT
      GAS_PHASE_OUTPUT = Y_SPECIES*RHO(II,JJ,KK)*MEC/2.3_EB

   CASE(100) ! PRESSURE ZONE
      GAS_PHASE_OUTPUT = PRESSURE_ZONE(II,JJ,KK)

   CASE(104) ! HRR
      Q_SUM = 0._EB
      DO K=DV%K1,DV%K2
         DO J=DV%J1,DV%J2
            DO I=DV%I1,DV%I2
               Q_SUM = Q_SUM + Q(I,J,K)*DX(I)*RC(I)*DY(J)*DZ(K)
            ENDDO
         ENDDO
      ENDDO
      GAS_PHASE_OUTPUT = Q_SUM*0.001_EB

   CASE(105:108) ! Hot Gas Layer Reduction
      CALL GET_LAYER_HEIGHT(DV%I1,DV%J1,DV%K1,DV%K2,ZINT,TMPUP,TMPLOW)
      IF (IND==105) GAS_PHASE_OUTPUT = ZINT
      IF (IND==106) GAS_PHASE_OUTPUT = TMPUP -TMPM
      IF (IND==107) GAS_PHASE_OUTPUT = TMPLOW-TMPM

   CASE(109)  ! FED
      YY_GET(:) = YY(II,JJ,KK,:)
      GAS_PHASE_OUTPUT = FED(YY_GET,RSUM(II,JJ,KK))

   CASE(110)  ! THERMOCOUPLE
      DENS    = RHO(II,JJ,KK)
      TMP_G   = TMP(II,JJ,KK)
      UIIINT  = UII(II,JJ,KK)
      UU      = U(II,JJ,KK)
      VV      = V(II,JJ,KK)
      WW      = W(II,JJ,KK)
      VEL2    = UU**2+VV**2+WW**2
      PR      = 0.7_EB
      MU_AIR  = Y2MU_C(MIN(5000,NINT(TMP_G)))*SPECIES(0)%MW
      RE_D    = DENS*SQRT(VEL2)*PY%BEAD_DIAMETER/MU_AIR
      NU_FAC  = 0.6_EB*PR**ONTH
      K_AIR   = CPOPR*MU_AIR
      NUSSELT = 2._EB + NU_FAC*SQRT(RE_D)
      H_TC    = NUSSELT*K_AIR/PY%BEAD_DIAMETER
      SRAD    = 0.25_EB*PY%BEAD_EMISSIVITY*UIIINT + H_TC*TMP_G
      TMP_TC  = 0.95_EB*TMP_G
      DO ITER=1,10
         F1 =    PY%BEAD_EMISSIVITY*SIGMA*TMP_TC**4 + H_TC*TMP_TC - SRAD
         F2 = 4._EB*PY%BEAD_EMISSIVITY*SIGMA*TMP_TC**3 + H_TC
         TMP_TC = TMP_TC - F1/F2
      ENDDO
      GAS_PHASE_OUTPUT = TMP_TC-TMPM

   CASE(111:119)  ! FLOWs
      FLOW = 0._EB
      DO K=DV%K1,DV%K2
         DO J=DV%J1,DV%J2
            DO I=DV%I1,DV%I2
               IP = I
               JP = J
               KP = K
               SELECT CASE(DV%IOR)
                  CASE(1)
                     IP   = I+1
                     VEL  = U(I,J,K)
                     AREA = DY(J)*DZ(K)*RC(I)
                     R_DN  = RDXN(I)
                  CASE(2)
                     JP   = J+1
                     VEL  = V(I,J,K)
                     AREA = DX(I)*DZ(K)
                     R_DN  = RDYN(J)
                  CASE(3)
                     KP   = K+1
                     VEL  = W(I,J,K)
                     AREA = DX(I)*DY(J)*RC(I)
                     R_DN  = RDZN(K)
               END SELECT
               IF (SPEC_INDEX /= 0) THEN
                  IF (SPEC_INDEX<0) THEN
                     YY_GET(:) = YY(I,J,K,:)
                     CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES)
                     YY_GET(:) = YY(IP,JP,KP,:)
                     CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES2)
                  ELSEIF (SPEC_INDEX>0) THEN
                     Y_SPECIES =YY(I,J,K,SPEC_INDEX)                  
                     Y_SPECIES2=YY(IP,JP,KP,SPEC_INDEX)
                  ENDIF
               ELSE
                  Y_SPECIES2 = 1._EB
               ENDIF
               IF (IND==111 .OR. IND==114 .OR. IND==117) HMFAC = 1._EB
               IF (IND==112 .OR. IND==115 .OR. IND==118) HMFAC = 0.5_EB*(Y_SPECIES*RHO(I,J,K)+Y_SPECIES2*RHO(IP,JP,KP))
               IF (IND==113 .OR. IND==116 .OR. IND==119) THEN
                  TMP_TC = 0.5_EB*(TMP(I,J,K)+TMP(IP,JP,KP))
                  ITMP=MIN(5000,NINT(TMP_TC))
                  IF (N_SPECIES>0) THEN
                     YY_G =0.5_EB*(YY(I,J,K,:)+YY(IP,JP,KP,:))
                     CALL GET_AVERAGE_SPECIFIC_HEAT(YY_G,H_G_SUM,ITMP)
                     CALL GET_AVERAGE_SPECIFIC_HEAT(YY_G,H_G,NINT(TMPA))
                  ELSE
                     H_G_SUM = Y2CPBAR_C(ITMP)
                     H_G     = Y2CPBAR_C(NINT(TMPA))
                  ENDIF
                  H_G_SUM = H_G_SUM*TMP_TC
                  H_G     = H_G    *TMPA
                  HMFAC = 0.5_EB*(RHO(I,J,K)+RHO(IP,JP,KP))*(H_G_SUM-H_G)*0.001_EB
               ENDIF
               SELECT CASE(IND)
                  CASE(111:113)
                     FLOW = FLOW + VEL*HMFAC*AREA
                  CASE(114:116)
                     FLOW = FLOW + MAX(0._EB,VEL)*HMFAC*AREA
                  CASE(117:119)
                     FLOW = FLOW - MIN(0._EB,VEL)*HMFAC*AREA
               END SELECT
               IF (IND==113 .OR. IND==116 .OR. IND==119) FLOW = FLOW - AREA*MU(I,J,K)*CPOPR*(TMP(IP,JP,KP)-TMP(I,J,K))*R_DN*0.001
            ENDDO
         ENDDO
      ENDDO
      GAS_PHASE_OUTPUT = FLOW

   CASE(120) ! HRRPUL
      GAS_PHASE_OUTPUT = 0._EB
      DO J=1,JBAR
         DO I=1,IBAR
            GAS_PHASE_OUTPUT = GAS_PHASE_OUTPUT + Q(I,J,KK)*DX(I)*RC(I)*DY(J)*0.001
         ENDDO
      ENDDO
      
   CASE(155) ! PATH OBSCURATION
      EXT_COEF = 0._EB
      IF (PY%SPEC_INDEX==0) THEN
         MASS_EXT_COEF = MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = SPECIES(PY%SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      DO NN=1,DV%N_PATH
         I = DV%I_PATH(NN)
         J = DV%J_PATH(NN)
         K = DV%K_PATH(NN)
         IF (PY%SPEC_INDEX==0) THEN
            YY_GET(:) = YY(I,J,K,:)
            CALL GET_MASS_FRACTION(YY_GET,SOOT_INDEX,Y_MF_INT)
        ELSE
            Y_MF_INT = YY(I,J,K,PY%SPEC_INDEX)
         ENDIF
         EXT_COEF = EXT_COEF + Y_MF_INT*RHO(I,J,K)*DV%D_PATH(NN)
      ENDDO
      GAS_PHASE_OUTPUT =  (1._EB - EXP(-1._EB*MASS_EXT_COEF*EXT_COEF))*100._EB
      
   CASE(156) ! SPRINKLER LINK TEMPERATURE
      I = DV%I
      J = DV%J
      K = DV%K
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 +(V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      WATER_VOL_FRAC = 0._EB
      DO NN = 1,N_PART
         IF (PARTICLE_CLASS(NN)%EVAP_INDEX/=0) WATER_VOL_FRAC = WATER_VOL_FRAC + & 
                                               AVG_DROP_DEN(I,J,K,PARTICLE_CLASS(NN)%EVAP_INDEX)/PARTICLE_CLASS(NN)%DENSITY
      ENDDO
      RHS      = ( VELSR*(TMP_G-DV%TMP_L) - PY%C_FACTOR*(DV%TMP_L-TMPA) - C_DIMARZO*VEL*WATER_VOL_FRAC )/PY%RTI
      DV%TMP_L = MAX(TMPA,DV%TMP_L + DT*RHS)
      GAS_PHASE_OUTPUT      = DV%TMP_L - TMPM

   CASE(157) ! LINK TEMPERATURE
      I = DV%I
      J = DV%J
      K = DV%K
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      DV%TMP_L  = DV%TMP_L + DT*VELSR*(TMP_G-DV%TMP_L)/PY%RTI
      GAS_PHASE_OUTPUT       = DV%TMP_L - TMPM

   CASE(158) ! CHAMBER OBSCURATION
      I = DV%I
      J = DV%J
      K = DV%K
      IF (PY%SPEC_INDEX==0) THEN
         YY_GET(:) = YY(I,J,K,:)
         CALL GET_MASS_FRACTION(YY_GET,SOOT_INDEX,Y_E)
         MASS_EXT_COEF = MASS_EXTINCTION_COEFFICIENT
      ELSE
         Y_E = YY(I,J,K,PY%SPEC_INDEX) 
         MASS_EXT_COEF = SPECIES(PY%SPEC_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      VEL2 = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL  = MAX(SQRT(VEL2),1.0E-10_EB)
      IF (DV%N_T_E>=UBOUND(DV%T_E,1)) THEN
         DV%T_E => REALLOCATE(DV%T_E,-1,DV%N_T_E+1000) 
         DV%Y_E => REALLOCATE(DV%Y_E,-1,DV%N_T_E+1000) 
      ENDIF
      DV%N_T_E = DV%N_T_E + 1
      DV%Y_E(DV%N_T_E) = Y_E
      DV%T_E(DV%N_T_E) = T
      DT_C = PY%ALPHA_C*VEL**PY%BETA_C
      DT_E = PY%ALPHA_E*VEL**PY%BETA_E
      Y_E_LAG = 0._EB
      LAG_LOOP: DO IL=DV%N_T_E-1,0,-1
         IF (DV%T_E(IL) > T-DT_E) CYCLE LAG_LOOP
         T_RATIO = (T-DT_E-DV%T_E(IL))/(DV%T_E(IL+1)-DV%T_E(IL))
         Y_E_LAG = DV%Y_E(IL) + T_RATIO*(DV%Y_E(IL+1)-DV%Y_E(IL))
         EXIT LAG_LOOP
      ENDDO LAG_LOOP
      DV%Y_C = DV%Y_C + DT*(Y_E_LAG - DV%Y_C)/DT_C
      GAS_PHASE_OUTPUT = (1._EB-EXP(-MASS_EXT_COEF*RHO(I,J,K)*DV%Y_C))*100._EB  ! Obscuration

   CASE(160) ! CONTROL
      IF (CONTROL(DV%CTRL_INDEX)%CURRENT_STATE) THEN
         GAS_PHASE_OUTPUT = 1._EB
      ELSE
         GAS_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(161) ! ASPIRATION
      GAS_PHASE_OUTPUT = 0._EB
      IF (T >= DV%T) THEN
         ! If enough time has passed shift soot density array
         DV%T = T + DV%DT
         DV%TIME_ARRAY(0:99) = DV%TIME_ARRAY(1:100)
         DV%YY_SOOT(:,0:99) = DV%YY_SOOT(:,1:100)
         DV%YY_SOOT(:,100) = 0._EB
      ENDIF
      DV%TIME_ARRAY(100) = T
      DO N = 1, DV%N_INPUTS
         ! Update soot density array
         DV2 => DEVICE(DV%DEVC_INDEX(N))
         IF (DV%T == T + DV%DT) THEN
            DV%YY_SOOT(N,100) = DV2%INSTANT_VALUE
         ELSE
            DV%YY_SOOT(N,100) = (DV%YY_SOOT(N,100) * (T - DV%TIME_ARRAY(99) - DT) +  DT * DV2%INSTANT_VALUE) / &
                                (T - DV%TIME_ARRAY(99))
         END IF
         ! Sum soot densities weighted by flow rate
         CALL INTERPOLATE1D(DV%TIME_ARRAY,DV%YY_SOOT(N,:),T-DV2%DELAY,Y_E)
         GAS_PHASE_OUTPUT = GAS_PHASE_OUTPUT + DV2%FLOWRATE * Y_E
      END DO
      ! Complete weighting and compute % obs
      GAS_PHASE_OUTPUT = GAS_PHASE_OUTPUT / DV%TOTAL_FLOWRATE
      GAS_PHASE_OUTPUT = (1._EB-EXP(-MASS_EXTINCTION_COEFFICIENT*GAS_PHASE_OUTPUT))*100._EB  ! Obscuration

   CASE(163) ! RADIATIVE HEAT FLUX GAS
      GAS_PHASE_OUTPUT = SUM(DV%ILW)*0.001_EB

   CASE(164) ! CABLE TEMPERATURE
      IW = DV%VIRTUAL_WALL_INDEX
      GAS_PHASE_OUTPUT = WALL(IW)%TMP_S(DV%I_DEPTH) - TMPM

   CASE(170) ! MPUV
      PC => PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT = AVG_DROP_DEN(II,JJ,KK,PC%EVAP_INDEX)

   CASE(171) ! ADD
      PC => PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT = AVG_DROP_RAD(II,JJ,KK,PC%EVAP_INDEX)*2.E6_EB

   CASE(172) ! ADT
      PC => PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT = AVG_DROP_TMP(II,JJ,KK,PC%EVAP_INDEX) - TMPM

   CASE(173) ! DROPLET FLUX X
      GAS_PHASE_OUTPUT = WFX(II,JJ,KK)

   CASE(174) ! DROPLET FLUX Y
      GAS_PHASE_OUTPUT = WFY(II,JJ,KK)

   CASE(175) ! DROPLET FLUX Z
      GAS_PHASE_OUTPUT = WFZ(II,JJ,KK)

   CASE(231) ! PDPA
      GAS_PHASE_OUTPUT = 0._EB
      IF ( ((PY%PDPA_START<=T) .AND.(PY%PDPA_END>=T)) .OR. .NOT.PY%PDPA_INTEGRATE ) THEN
         IF ((PY%PDPA_M-PY%PDPA_N) == 0) THEN
            EXPON = 1._EB
         ELSEIF ((PY%QUANTITY=='MASS CONCENTRATION') .OR. &
                 (PY%QUANTITY=='ENTHALPY')           .OR. &
                 (PY%QUANTITY=='DROPLET FLUX X')     .OR. &
                 (PY%QUANTITY=='DROPLET FLUX Y')     .OR. &
                 (PY%QUANTITY=='DROPLET FLUX Z')) THEN
            EXPON = 1._EB
         ELSE
            EXPON = 1._EB/(PY%PDPA_M-PY%PDPA_N)
         ENDIF
         IF (.NOT.PY%PDPA_INTEGRATE) THEN
            DV%PDPA_NUMER = 0._EB
            DV%PDPA_DENUM = 0._EB
         ENDIF
         IF (PY%QUANTITY == 'NUMBER CONCENTRATION') DV%PDPA_DENUM = DV%PDPA_DENUM + FOTH*PI*PY%PDPA_RADIUS**3
         IF (PY%QUANTITY == 'MASS CONCENTRATION' .OR. &
             PY%QUANTITY == 'ENTHALPY'           .OR. &
             PY%QUANTITY == 'DROPLET FLUX X'     .OR. &
             PY%QUANTITY == 'DROPLET FLUX Y'     .OR. &
             PY%QUANTITY == 'DROPLET FLUX Z' ) THEN
             IF (PY%PDPA_NORMALIZE) THEN
                DV%PDPA_DENUM = DV%PDPA_DENUM + FOTH*PI*(2._EB*PY%PDPA_RADIUS)**3
             ELSE
                DV%PDPA_DENUM = 8._EB
             ENDIF
         ENDIF
         DLOOP: DO I=1,NLP
            DR=>DROPLET(I)
            IPC=DR%CLASS
            PC=>PARTICLE_CLASS(IPC)
            IF (PY%PART_INDEX/=IPC .AND. PY%PART_INDEX/=0) CYCLE DLOOP
            IF ((DR%X-DV%X)**2+(DR%Y-DV%Y)**2+(DR%Z-DV%Z)**2 > PY%PDPA_RADIUS**2) CYCLE DLOOP
            SELECT CASE(PY%QUANTITY)
               CASE('U-VELOCITY') 
                  VEL = DR%U
               CASE('V-VELOCITY')
                  VEL = DR%V
               CASE('W-VELOCITY')
                  VEL = DR%W
               CASE('VELOCITY') 
                  VEL = SQRT(DR%U**2 + DR%V**2 + DR%W**2)
               CASE('DROPLET FLUX X') 
                  VEL = PC%FTPR*DR%U
               CASE('DROPLET FLUX Y') 
                  VEL = PC%FTPR*DR%V
               CASE('DROPLET FLUX Z') 
                  VEL = PC%FTPR*DR%W
               CASE('MASS CONCENTRATION') 
                  VEL = PC%FTPR
               CASE('TEMPERATURE')
                  VEL = DR%TMP - TMPM
               CASE('ENTHALPY')
                  VEL = 0.001_EB*PC%FTPR*(PC%C_P_BAR(NINT(DR%TMP))*DR%TMP - PC%C_P_BAR(NINT(PC%TMP_MELT))*PC%TMP_MELT)
               CASE DEFAULT
                  VEL = 1.0_EB
            END SELECT
            ! Compute numerator and denumerator
            DV%PDPA_NUMER = DV%PDPA_NUMER + DR%PWT*(2._EB*DR%R)**PY%PDPA_M * VEL
            IF ((PY%QUANTITY /= 'NUMBER CONCENTRATION') .AND. &
                (PY%QUANTITY /= 'MASS CONCENTRATION') .AND. &
                (PY%QUANTITY /= 'DROPLET FLUX X') .AND. &
                (PY%QUANTITY /= 'DROPLET FLUX Y') .AND. &
                (PY%QUANTITY /= 'DROPLET FLUX Z') .AND. &
                (PY%QUANTITY /= 'ENTHALPY')) THEN
               DV%PDPA_DENUM = DV%PDPA_DENUM + DR%PWT*(2._EB*DR%R)**PY%PDPA_N
            ENDIF
         ENDDO DLOOP
         IF (DV%PDPA_DENUM > 0._EB) GAS_PHASE_OUTPUT = (DV%PDPA_NUMER/DV%PDPA_DENUM)**EXPON         
      ENDIF
   END SELECT

END FUNCTION GAS_PHASE_OUTPUT



REAL(EB) FUNCTION SOLID_PHASE_OUTPUT(NM,IWX,INDX,SPEC_INDEX,PART_INDEX)

! Compute Solid Phase DEVICE Output Quantities
 
USE PHYSICAL_FUNCTIONS, ONLY: SURFACE_DENSITY, GET_MASS_FRACTION
INTEGER, INTENT(IN) :: IWX,INDX,SPEC_INDEX,PART_INDEX,NM
REAL(EB) :: CONCORR,U2,V2,W2,HQ2,FLUX,DFLUXDT,SOLID_PHASE_OUTPUT_OLD,YY_GET(1:N_SPECIES),Y_SPECIES
INTEGER :: IOR,II1,II2,II,JJ,KK,IIG,JJG,KKG,NN

IF (BOUNDARY_TYPE(IWX)==NULL_BOUNDARY) THEN
   SOLID_PHASE_OUTPUT = OUTPUT_QUANTITY(-INDX)%AMBIENT_VALUE
   RETURN
ENDIF

! Find the appropriate solid phase output quantity

SELECT CASE(INDX)
   CASE( 1) ! RADIATIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = (QRADIN(IWX)-QRADOUT(IWX))*0.001_EB
   CASE( 2) ! CONVECTIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = QCONF(IWX)*0.001_EB
   CASE( 3) ! NORMAL VELOCITY
      SOLID_PHASE_OUTPUT = UW(IWX)
   CASE( 4) ! GAS TEMPERATURE
      IIG = IJKW(6,IWX)
      JJG = IJKW(7,IWX)
      KKG = IJKW(8,IWX)
      SOLID_PHASE_OUTPUT = TMP(IIG,JJG,KKG) - TMPM
   CASE( 5) ! WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = TMP_F(IWX) - TMPM

   CASE( 6) ! INSIDE WALL TEMPERATURE
      IF (SURFACE(IJKW(5,IWX))%SHRINK) THEN
         II2 = SUM(WALL(IWX)%N_LAYER_CELLS)
         IF (DV%DEPTH>WALL(IWX)%X_S(II2)) THEN
            SOLID_PHASE_OUTPUT = TMPA-TMPM
         ELSE
            DO II2=II2,1,-1
               IF (DV%DEPTH<=WALL(IWX)%X_S(II2)) II1 = II2
            ENDDO
            SOLID_PHASE_OUTPUT = WALL(IWX)%TMP_S(II1)-TMPM
         ENDIF
      ELSE
         SOLID_PHASE_OUTPUT = WALL(IWX)%TMP_S(DV%I_DEPTH) - TMPM
      ENDIF

   CASE( 7) ! BURNING RATE
      SOLID_PHASE_OUTPUT = MASSFLUX_ACTUAL(IWX,I_FUEL)
   CASE( 8) ! HRRPUM
      SOLID_PHASE_OUTPUT = MASSFLUX(IWX,I_FUEL)*0.001*REACTION(1)%HEAT_OF_COMBUSTION/SURFACE(IJKW(5,IWX))%SURFACE_DENSITY
   CASE(10) ! NET HEAT FLUX
      SOLID_PHASE_OUTPUT = (QRADIN(IWX)-QRADOUT(IWX)+QCONF(IWX))*0.001_EB

   CASE(11) ! PRESSURE COEFFICIENT
      II  = IJKW(1,IWX)
      JJ  = IJKW(2,IWX)
      KK  = IJKW(3,IWX)
      IIG = IJKW(6,IWX)
      JJG = IJKW(7,IWX)
      KKG = IJKW(8,IWX)
      IOR = IJKW(4,IWX)
      SELECT CASE(IOR)
         CASE(1,-1)
            IF (IOR==-1) U2 = U(IIG,JJG,KKG)**2
            IF (IOR== 1) U2 = U(II ,JJG,KKG)**2
            V2 = 0.0625_EB*( V(IIG,JJG,KKG)+V(IIG,JJG-1,KKG)+V(II ,JJG,KKG)+V(II ,JJG-1,KKG) )**2
            W2 = 0.0625_EB*( W(IIG,JJG,KKG)+W(IIG,JJG,KKG-1)+W(II ,JJG,KKG)+W(II ,JJG,KKG-1) )**2
         CASE(2,-2)
            IF (IOR==-2) V2 = V(IIG,JJG,KKG)**2
            IF (IOR== 2) V2 = V(IIG,JJ ,KKG)**2
            U2 = 0.0625_EB*( U(IIG,JJG,KKG)+U(IIG-1,JJG,KKG)+U(IIG,JJ ,KKG)+U(IIG-1,JJ ,KKG) )**2
            W2 = 0.0625_EB*( W(IIG,JJG,KKG)+W(IIG,JJG,KKG-1)+W(IIG,JJ ,KKG)+W(IIG,JJ ,KKG-1) )**2
         CASE(3,-3)
            IF (IOR==-3) W2 = W(IIG,JJG,KKG)**2
            IF (IOR== 3) W2 = W(IIG,JJG,KK )**2
            U2 = 0.0625_EB*( U(IIG,JJG,KKG)+U(IIG-1,JJG,KKG)+U(IIG,JJG,KK )+U(IIG-1,JJG,KK ) )**2
            V2 = 0.0625_EB*( V(IIG,JJG,KKG)+V(IIG,JJG-1,KKG)+V(IIG,JJG,KK )+V(IIG,JJG-1,KK ) )**2
      END SELECT
      HQ2 = 0.5_EB*(U2+V2+W2)
      SOLID_PHASE_OUTPUT = (H(IIG,JJG,KKG)-HQ2)/(0.5_EB*PY%CHARACTERISTIC_VELOCITY**2)
   CASE(12) ! BACK WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = TMP_B(IWX) - TMPM
   CASE(13) ! GAUGE HEAT FLUX
      CONCORR = HEAT_TRANS_COEF(IWX)*(TMP_F(IWX)-PY%GAUGE_TEMPERATURE)
      SOLID_PHASE_OUTPUT = (QRADIN(IWX)/(E_WALL(IWX)+1.0E-10_EB) - SIGMA*PY%GAUGE_TEMPERATURE**4 + QCONF(IWX) + CONCORR)*0.001_EB
   CASE(19) ! INCIDENT HEAT FLUX
      SOLID_PHASE_OUTPUT = ( QRADIN(IWX)/(E_WALL(IWX)+1.0E-10_EB) + QCONF(IWX) )*0.001_EB
   CASE(20) ! MASS FLUX
      IF (SPEC_INDEX<0) THEN
         YY_GET(:) = ABS(MASSFLUX(IWX,1:N_SPECIES))
         FLUX = SUM(YY_GET)
         IF (FLUX > 0._EB) THEN
            YY_GET(:) = YY_GET/FLUX
            CALL GET_MASS_FRACTION(YY_GET,-SPEC_INDEX,Y_SPECIES)
            SOLID_PHASE_OUTPUT = SUM(MASSFLUX(IWX,:))*Y_SPECIES
         ENDIF
      ENDIF
      IF (SPEC_INDEX>=0) SOLID_PHASE_OUTPUT = MASSFLUX(IWX,SPEC_INDEX)
   CASE(21) ! HEAT TRANSFER COEFFICENT
      SOLID_PHASE_OUTPUT = HEAT_TRANS_COEF(IWX)
   CASE(22) ! RADIOMETER
      SOLID_PHASE_OUTPUT = (QRADIN(IWX)/(E_WALL(IWX)+1.0E-10_EB) - SIGMA*PY%GAUGE_TEMPERATURE**4)*0.001_EB
   CASE(23) ! ADIABATIC SURFACE TEMPERATURE
      SOLID_PHASE_OUTPUT_OLD = TMP_F(IWX)
      SOLID_PHASE_OUTPUT     = TMP_F(IWX)
      ADLOOP: DO
         CONCORR = HEAT_TRANS_COEF(IWX)*(TMP_F(IWX)-SOLID_PHASE_OUTPUT_OLD)      
         FLUX = QCONF(IWX) + CONCORR + QRADIN(IWX) - E_WALL(IWX) * SIGMA * SOLID_PHASE_OUTPUT_OLD ** 4
         DFLUXDT = -4._EB*E_WALL(IWX)*SIGMA*SOLID_PHASE_OUTPUT_OLD**3 - HEAT_TRANS_COEF(IWX)
         IF (DFLUXDT /= 0._EB) SOLID_PHASE_OUTPUT_OLD = SOLID_PHASE_OUTPUT_OLD - FLUX / DFLUXDT
         IF (ABS(SOLID_PHASE_OUTPUT_OLD - SOLID_PHASE_OUTPUT) / SOLID_PHASE_OUTPUT < 0.0001_EB) THEN
               SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT_OLD
               EXIT ADLOOP
         ELSE
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT_OLD
            CYCLE ADLOOP
         ENDIF
      ENDDO ADLOOP  
      SOLID_PHASE_OUTPUT_OLD = TMP_F(IWX)
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT - TMPM

   CASE(24) ! WALL THICKNESS
      IF (SURFACE(IJKW(5,IWX))%SHRINK) THEN
         SOLID_PHASE_OUTPUT = SUM(WALL(IWX)%LAYER_THICKNESS)
      ELSE
         IF (SURFACE(IJKW(5,IWX))%THERMALLY_THICK) THEN
            SOLID_PHASE_OUTPUT = MAXVAL(SURFACE(IJKW(5,IWX))%X_S)
         ELSE
            SOLID_PHASE_OUTPUT = 0._EB
         ENDIF
      ENDIF

      IF (SURFACE(IJKW(5,IWX))%VEGETATION) THEN     !surface vegetation height
         SOLID_PHASE_OUTPUT = WALL(IWX)%VEG_HEIGHT
      ENDIF

   CASE(25) ! SURFACE DENSITY
      SOLID_PHASE_OUTPUT = SURFACE_DENSITY(NM,IWX,0)

   CASE(26) ! SOLID DENSITY
      SF => SURFACE(IJKW(5,IWX))
      II1 = DV%I_DEPTH
      IF (SF%SHRINK) THEN
         II2 = SUM(WALL(IWX)%N_LAYER_CELLS)
         IF (DV%DEPTH>WALL(IWX)%X_S(II2)) THEN
            SOLID_PHASE_OUTPUT = 0._EB
            RETURN
         ELSE
            DO II2=II2,1,-1
               IF (DV%DEPTH<=WALL(IWX)%X_S(II2)) II1 = II2
            ENDDO
         ENDIF
      ENDIF
      DO NN=1,SF%N_MATL
         IF (DV%MATL_ID==SF%MATL_NAME(NN)) THEN
            SOLID_PHASE_OUTPUT = WALL(IWX)%RHO_S(II1,NN)
            RETURN
         ENDIF
      ENDDO
      SOLID_PHASE_OUTPUT = 0._EB

   CASE(27) ! EMISSIVITY
      SOLID_PHASE_OUTPUT = E_WALL(IWX)

   CASE(28) ! SOOT SURFACE DENSITY
      SOLID_PHASE_OUTPUT = AWMSOOT(IWX)
        
   CASE(30) ! MPUA
      PC => PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT = WMPUA(IWX,PC%EVAP_INDEX)
   CASE(31) ! CPUA
      PC => PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT = WCPUA(IWX,PC%EVAP_INDEX)*0.001_EB
   CASE(32) ! AMPUA
      PC => PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT = AWMPUA(IWX,PC%EVAP_INDEX)
END SELECT

END FUNCTION SOLID_PHASE_OUTPUT



REAL(EB) FUNCTION HVAC_OUTPUT(IND,SPEC_INDEX,DUCT_INDEX,NODE_INDEX)

! Compute HVAC Output Quantities

USE MEMORY_FUNCTIONS, ONLY: REALLOCATE
USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D,EVALUATE_RAMP
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION,GET_MOLECULAR_WEIGHT
USE CONTROL_VARIABLES, ONLY: CONTROL
INTEGER, INTENT(IN) :: SPEC_INDEX,IND,DUCT_INDEX,NODE_INDEX
REAL(EB) :: Y_H2O,YY_G(1:N_SPECIES),MW,Y_SPECIES

SELECT CASE(IND)
   CASE DEFAULT
      HVAC_OUTPUT = 0._EB
   CASE(300)  ! Duct Velocity
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)
   CASE(301)  ! Duct Temperature
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TMP_D
   CASE(302)  ! Duct Mass Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%RHO_D*DUCT(DUCT_INDEX)%AREA
   CASE(303)  ! Duct Volume Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%AREA
   CASE(304:305)!Species
      Y_H2O = 0._EB
      IF (SPEC_INDEX<0) THEN
         YY_G(:) = DUCT(DUCT_INDEX)%YY(:)
         CALL GET_MASS_FRACTION(YY_G,-SPEC_INDEX,Y_SPECIES)
         IF (DRY) THEN
            CALL GET_MASS_FRACTION(YY_G,H2O_INDEX,Y_H2O)
            IF (-SPEC_INDEX==H2O_INDEX) Y_SPECIES=0._EB
         ENDIF
      ELSEIF (SPEC_INDEX>0) THEN
         Y_SPECIES=DUCT(DUCT_INDEX)%YY(SPEC_INDEX)
      ELSE
         Y_SPECIES=1.0_EB
      ENDIF
      IF (IND==304) THEN
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE
         CALL GET_MOLECULAR_WEIGHT(YY_G,MW)
         IF (SPEC_INDEX<0) THEN
            HVAC_OUTPUT = RCON_MF(-SPEC_INDEX)/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
         ELSEIF (SPEC_INDEX>0) THEN
            HVAC_OUTPUT = Y_SPECIES*MW/SPECIES(SPEC_INDEX)%MW
         ENDIF
      ENDIF
   CASE(306)  ! Duct Density
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%RHO_D
   CASE(330) ! Node Pressure
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX)%P
   CASE(331) ! Node Density
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX)%RHO
   CASE(332) ! Node Temperature
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX)%TMP
   CASE(333:334)!Species
      Y_H2O = 0._EB
      IF (SPEC_INDEX<0) THEN
         YY_G(:) = DUCTNODE(NODE_INDEX)%YY(:)
         CALL GET_MASS_FRACTION(YY_G,-SPEC_INDEX,Y_SPECIES)
         IF (DRY) THEN
            CALL GET_MASS_FRACTION(YY_G,H2O_INDEX,Y_H2O)
            IF (-SPEC_INDEX==H2O_INDEX) Y_SPECIES=0._EB
         ENDIF
      ELSEIF (SPEC_INDEX>0) THEN
         Y_SPECIES=DUCTNODE(NODE_INDEX)%YY(SPEC_INDEX)
      ELSE
         Y_SPECIES=1.0_EB
      ENDIF
      IF (IND==333) THEN
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE
         CALL GET_MOLECULAR_WEIGHT(YY_G,MW)
         IF (SPEC_INDEX<0) THEN
            HVAC_OUTPUT = RCON_MF(-SPEC_INDEX)/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
         ELSEIF (SPEC_INDEX>0) THEN
            HVAC_OUTPUT = Y_SPECIES*MW/SPECIES(SPEC_INDEX)%MW
         ENDIF
      ENDIF   
   
END SELECT   
   
END FUNCTION HVAC_OUTPUT

  
SUBROUTINE DUMP_DEVICES(T)

! Write out to CHID_devc.csv the DEViCe output quantities every DT_DEVC s

REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME
INTEGER :: I,N,NN
REAL(EB) :: DEVC_TIME
LOGICAL :: OPN

! Determine the time to write into file

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
DEVC_TIME=STIME

IF (CENTERED_DEVC_TIME) THEN
   IF (STIME>T_BEGIN+DT_DEVC) THEN
      DEVC_TIME = STIME - DT_DEVC/2.0
   ELSE
      DEVC_TIME = T_BEGIN + STIME/2.0
   ENDIF
ENDIF

! Load time and line device values into arrays

NN = 0
DO N=1,N_DEVC
   DV => DEVICE(N)
   IF (DV%LINE==0) THEN
      NN = NN + 1
      TIME_DEVC_VALUE(NN) = DV%VALUE/DV%TIME_INTERVAL
   ENDIF
ENDDO

! Dump time histories

IF (COLUMN_DUMP_LIMIT) THEN
   DO I=1,N_DEVC_FILES
      WRITE(TCFORM,'(A,I4.4,A)') "(",MIN(DEVC_COLUMN_LIMIT, N_DEVC_TIME - DEVC_COLUMN_LIMIT * (I - 1)),"(ES15.7E3,','),ES15.7E3)"
      WRITE(LU_DEVC(I),TCFORM) DEVC_TIME,(TIME_DEVC_VALUE(N),N=DEVC_COLUMN_LIMIT*(I-1)+1, MIN(N_DEVC_TIME,DEVC_COLUMN_LIMIT*I))
   ENDDO
ELSE
   WRITE(TCFORM,'(A,I4.4,A)') "(",N_DEVC_TIME,"(ES15.7E3,','),ES15.7E3)"
   WRITE(LU_DEVC(1),TCFORM) DEVC_TIME,(TIME_DEVC_VALUE(N), N=1,N_DEVC_TIME)
ENDIF

! Dump line device file

IF (N_DEVC_LINE>0) THEN

   LINE_DEVC_VALUE = 'NaN,NaN,NaN,NaN'
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0) THEN
         WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),'(3(ES15.7E3,A),ES15.7E3)') DV%X,',',DV%Y,',',DV%Z,',',DV%VALUE/DV%TIME_INTERVAL
      ENDIF
   ENDDO

   INQUIRE(LU_LINE,OPENED=OPN)
   IF (OPN) CLOSE(LU_LINE)
   OPEN(LU_LINE,FILE=FN_LINE,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(TCFORM,'(A,I4.4,A)') "(",N_DEVC_LINE-1,"(A,','),A)"
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_UNITS(N)),N=1,N_DEVC_LINE)
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_LABEL(N)),N=1,N_DEVC_LINE)
   DO N=1,MAX_DEVC_LINE_POINTS
      WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_VALUE(NN,N)),NN=1,N_DEVC_LINE)
   ENDDO

ENDIF

END SUBROUTINE DUMP_DEVICES



SUBROUTINE DUMP_CONTROLS(T)

! Write out to CHID_ctrl.csv the ConTRoL output quantities every DT_CTRL s

USE CONTROL_VARIABLES
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: WRITE_VALUE(N_CTRL)
INTEGER :: I,N
 
STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
WHERE (CONTROL%CURRENT_STATE)
   WRITE_VALUE=1
ELSEWHERE
   WRITE_VALUE=-1
END WHERE
IF (COLUMN_DUMP_LIMIT) THEN
   DO I=1,N_CTRL_FILES
      WRITE(TCFORM,'(A,I4.4,A)') "(ES13.5E3,",MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1)),"(',',I4.3))"
      WRITE(LU_CTRL(I),TCFORM) STIME,(WRITE_VALUE(N), N=CTRL_COLUMN_LIMIT*(I-1)+1, MIN(N_CTRL,CTRL_COLUMN_LIMIT*I))
   ENDDO
ELSE
   WRITE(TCFORM,'(A,I4.4,A)') "(ES13.5E3,",N_CTRL,"(',',I4.3))"
   WRITE(LU_CTRL(1),TCFORM) STIME,(WRITE_VALUE(N), N=1,N_CTRL)
ENDIF

END SUBROUTINE DUMP_CONTROLS
 
 
SUBROUTINE DUMP_PROF(T,NM)

! Write out to CHID_prof_nn.csv the PROFile data every DT_PROF s

USE GEOMETRY_FUNCTIONS, ONLY : GET_WALL_NODE_WEIGHTS
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER, INTENT(IN)  :: NM
INTEGER :: I,N,NN,IW,IBC,NWP
REAL(EB) :: DXF,DXB,THICKNESS
TYPE (PROFILE_TYPE), POINTER :: PF=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
PROF_LOOP: DO N=1,N_PROF
   PF  => PROFILE(N)
   IF (NM/=PF%MESH) CYCLE PROF_LOOP
   M   => MESHES(NM)
   IW  =  PF%IW
   WC  => MESHES(NM)%WALL(IW)
   IF (.NOT.WC%ALREADY_ALLOCATED .OR. BOUNDARY_TYPE(IW)==NULL_BOUNDARY) CYCLE PROF_LOOP
   IBC =  M%IJKW(5,IW)
   SF  => SURFACE(IBC)
   IF (SF%SHRINK) THEN
      NWP = SUM(WC%N_LAYER_CELLS)
      IF (NWP==0) CYCLE PROF_LOOP
      X_S_NEW(0:NWP) = WC%X_S(0:NWP)
      THICKNESS = SUM(WC%LAYER_THICKNESS)
      CALL GET_WALL_NODE_WEIGHTS(NWP,SF%N_LAYERS,WC%N_LAYER_CELLS,WC%LAYER_THICKNESS,SF%GEOMETRY, &
         WC%X_S(0:NWP),SF%LAYER_DIVIDE,DX_S(1:NWP),RDX_S(0:NWP+1),RDXN_S(0:NWP),DX_WGT_S(0:NWP),DXF,DXB,LAYER_INDEX,MF_FRAC)
   ELSE
      NWP = SF%N_CELLS
      IF (NWP==0) CYCLE PROF_LOOP
      X_S_NEW(0:NWP) = SF%X_S(0:NWP)
      DX_WGT_S(0:NWP) = SF%DX_WGT(0:NWP)
   ENDIF
   WRITE(TCFORM,'(A,I5,A)') "(ES13.5E3,',',I5,',',",(2*NWP+1),"(ES13.5E3,','),ES13.5E3)"
   IF (PF%QUANTITY == 'TEMPERATURE') THEN
      WRITE(LU_PROF(N),TCFORM) STIME,NWP+1,(X_S_NEW(I),I=0,NWP),(WC%TMP_S(I)+DX_WGT_S(I)*(WC%TMP_S(I+1)-WC%TMP_S(I))-TMPM,I=0,NWP)
   ELSE
      WC%RHO_S(0,1:SF%N_MATL)     = WC%RHO_S(1,1:SF%N_MATL)
      WC%RHO_S(NWP+1,1:SF%N_MATL) = WC%RHO_S(NWP,1:SF%N_MATL)
      RHO_S = 0._EB
      DO NN=1,SF%N_MATL
         IF (PF%QUANTITY==SF%MATL_NAME(NN) .OR. PF%QUANTITY=='DENSITY') THEN
            DO I=0,NWP+1
               RHO_S(I) = RHO_S(I) + WC%RHO_S(I,NN)
            ENDDO
         ENDIF
      ENDDO
      WRITE(LU_PROF(N),TCFORM) STIME,NWP+1,(X_S_NEW(I),I=0,NWP),(RHO_S(I)+DX_WGT_S(I)*(RHO_S(I+1)-RHO_S(I)),I=0,NWP)
   ENDIF
ENDDO PROF_LOOP
 
END SUBROUTINE DUMP_PROF



SUBROUTINE UPDATE_HRR(NM)

! Compute the total heat release rate and the radiative loss part

USE PHYSICAL_FUNCTIONS, ONLY : GET_AVERAGE_SPECIFIC_HEAT
REAL(EB) :: VC,TMP_N,RHO_N,U_N,H_G,YY_N(1:N_SPECIES),E_DIFF
INTEGER, INTENT(IN) :: NM
INTEGER :: IOR,I,J,K,IW,IIG,JJG,KKG,ITMP

HRR(NM)  = 0._EB
RHRR(NM) = 0._EB
CHRR(NM) = 0._EB
FHRR(NM) = 0._EB
MLR(NM)  = 0._EB

IF (EVACUATION_ONLY(NM)) RETURN

CALL POINT_TO_MESH(NM)

DO K=1,KBAR
   DO J=1,JBAR
      ILOOP2: DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) CYCLE ILOOP2
         IF (NM>1) THEN
         IF (INTERPOLATED_MESH(I,J,K)>0) CYCLE ILOOP2
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         HRR(NM)  = HRR(NM)  + Q(I,J,K)*VC
         RHRR(NM) = RHRR(NM) - QR(I,J,K)*VC
      ENDDO ILOOP2
   ENDDO
ENDDO

WALL_LOOP: DO IW=1,NWC
   IF (BOUNDARY_TYPE(IW)/=SOLID_BOUNDARY .AND. BOUNDARY_TYPE(IW)/=OPEN_BOUNDARY) CYCLE WALL_LOOP
   IIG = IJKW(6,IW)
   JJG = IJKW(7,IW)
   KKG = IJKW(8,IW)
      
   IF (NM>1) THEN
      IF (INTERPOLATED_MESH(IIG,JJG,KKG)>0) CYCLE WALL_LOOP
   ENDIF
   IOR = IJKW(4,IW)
   TMP_N = TMP_F(IW)
   RHO_N = RHO_F(IW)
   SELECT CASE(IOR)
      CASE( 1) 
         U_N = -U(IIG-1,JJG,KKG)
      CASE(-1) 
         U_N =  U(IIG,JJG,KKG)
      CASE( 2) 
         U_N = -V(IIG,JJG-1,KKG)
      CASE(-2) 
         U_N =  V(IIG,JJG,KKG)
      CASE( 3) 
         U_N = -W(IIG,JJG,KKG-1)
      CASE(-3) 
         U_N =  W(IIG,JJG,KKG)
   END SELECT
   ITMP = MIN(5000,NINT(TMP_N))
   IF (N_SPECIES>0) THEN
      YY_N = YY_F(IW,:)
      CALL GET_AVERAGE_SPECIFIC_HEAT(YY_N,H_G,ITMP)
   ELSE
      H_G = Y2CPBAR_C(ITMP)
   ENDIF
   H_G = H_G * TMP_N
   IF (MIXTURE_FRACTION .AND. H2O_INDEX > 0) THEN
      H_G = H_G - YY_N(I_PROG_F) * H_G_H2O_FAC
      IF (CO_PRODUCTION)  H_G = H_G - YY_N(I_PROG_CO) * H_G_H2O_FAC
   ENDIF
   IF (BOUNDARY_TYPE(IW)==SOLID_BOUNDARY) CHRR(NM) = CHRR(NM) + (QCONF(IW)+QRADIN(IW)-QRADOUT(IW))*AW(IW)
   IF (BOUNDARY_TYPE(IW)==OPEN_BOUNDARY) THEN
      E_DIFF = QCONF(IW)
   ELSE
      E_DIFF = 0._EB
   ENDIF
   IF (ABS(U_N) > ZERO_P) FHRR(NM) = FHRR(NM) + (U_N*RHO_N*H_G+E_DIFF)*AW(IW)
   MLR(NM)  = MLR(NM)  + MASSFLUX_ACTUAL(IW,I_FUEL)*AW(IW)*AREA_ADJUST(IW)
ENDDO WALL_LOOP

HRR_SUM(NM)  = HRR_SUM(NM)  + DT*HRR(NM)
RHRR_SUM(NM) = RHRR_SUM(NM) + DT*RHRR(NM)
CHRR_SUM(NM) = CHRR_SUM(NM) + DT*CHRR(NM)
FHRR_SUM(NM) = FHRR_SUM(NM) + DT*FHRR(NM)
MLR_SUM(NM)  = MLR_SUM(NM)  + DT*(MLR(NM)+FUEL_DROPLET_MLR(NM))
HRR_TIME_INTERVAL(NM)= HRR_TIME_INTERVAL(NM) + DT

END SUBROUTINE UPDATE_HRR
 
 
SUBROUTINE DUMP_HRR(T)

! Record HRR, etc, in the file CHID_hrr.csv
 
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: NM,I
REAL(EB) :: HRR_TOTAL,RHRR_TOTAL,CHRR_TOTAL,FHRR_TOTAL,MLR_TOTAL
REAL :: HRR_TIME
 
STIME      = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
HRR_TOTAL  = 0._EB
RHRR_TOTAL = 0._EB
CHRR_TOTAL = 0._EB
FHRR_TOTAL = 0._EB
MLR_TOTAL  = 0._EB
 
DO NM=1,NMESHES
   IF (HRR_TIME_INTERVAL(NM)>0._EB) THEN
      HRR_TOTAL  = HRR_TOTAL  + HRR_SUM(NM)/HRR_TIME_INTERVAL(NM)
      RHRR_TOTAL = RHRR_TOTAL + RHRR_SUM(NM)/HRR_TIME_INTERVAL(NM)
      CHRR_TOTAL = CHRR_TOTAL + CHRR_SUM(NM)/HRR_TIME_INTERVAL(NM)
      FHRR_TOTAL = FHRR_TOTAL + FHRR_SUM(NM)/HRR_TIME_INTERVAL(NM)
      MLR_TOTAL  = MLR_TOTAL  + MLR_SUM(NM)/HRR_TIME_INTERVAL(NM)
   ENDIF
ENDDO
 
WRITE(TCFORM,'(A,I4.4,A)') "(",5+N_ZONE,"(ES15.7E3,','),ES15.7E3)"

HRR_TIME=STIME
IF(CENTERED_HRR_TIME)THEN
  ! if flag is set then output time at center of averaging window, assume averaging windows is
  !
  !   [stime-DT_HRR, stime]    if t>= T_BEGIN+DT_HRR,      so center of window is stime - DT_HRR/2
  !   [T_BEGIN, T_BEGIN+stime] if stime <= T_BEGIN+DT_HRR, so center of window is T_BEGIN+stime/2 
  IF(STIME.GE.T_BEGIN+DT_HRR)THEN
    HRR_TIME = STIME - DT_HRR/2.0
   ELSE
    HRR_TIME = T_BEGIN+STIME/2.0
  ENDIF
ENDIF

WRITE(LU_HRR,TCFORM) HRR_TIME,0.001_EB*HRR_TOTAL, .001_EB*RHRR_TOTAL,.001_EB*FHRR_TOTAL,.001_EB*CHRR_TOTAL, & 
                     MLR_TOTAL,(MESHES(1)%PBAR(1,I)/P_STP,I=1,N_ZONE)
 
END SUBROUTINE DUMP_HRR
 

SUBROUTINE DUMP_VEG(T)

! --- temporary (place holder) ouput routine
! Write out total dry and moisture mass in vegetation (fuel element model)
 
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: I,NM,N_TREE
LOGICAL :: VEG_PRESENT

VEG_PRESENT = .FALSE.
STIME      = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

IF (N_TREES_OUT == 0) RETURN

TREE_OUTPUT_DATA_TOTAL = 0._EB

MESH_LOOP: DO NM=1,NMESHES

  IF (.NOT. TREE_MESH_OUT(NM)) CYCLE MESH_LOOP 
   VEG_PRESENT = .TRUE.
!  R_SVxPR = 1.0_EB/PC%VEG_SV*DR%VEG_PACKING_RATIO
   DO N_TREE = 1, N_TREES_OUT
    TREE_OUTPUT_DATA_TOTAL(N_TREE,1) = TREE_OUTPUT_DATA_TOTAL(N_TREE,1) + TREE_OUTPUT_DATA(N_TREE,1,NM) !kg
    TREE_OUTPUT_DATA_TOTAL(N_TREE,2) = TREE_OUTPUT_DATA_TOTAL(N_TREE,2) + TREE_OUTPUT_DATA(N_TREE,2,NM) !kg
    TREE_OUTPUT_DATA_TOTAL(N_TREE,3) = TREE_OUTPUT_DATA_TOTAL(N_TREE,3) + TREE_OUTPUT_DATA(N_TREE,3,NM) !kW
    TREE_OUTPUT_DATA_TOTAL(N_TREE,4) = TREE_OUTPUT_DATA_TOTAL(N_TREE,4) + TREE_OUTPUT_DATA(N_TREE,4,NM) !kW
   ENDDO

ENDDO MESH_LOOP
 
IF (VEG_PRESENT) THEN
 DO I=1,N_TREES_OUT
  WRITE(LU_VEG_OUT(I),'(5(ES12.4))')T,TREE_OUTPUT_DATA_TOTAL(I,1),TREE_OUTPUT_DATA_TOTAL(I,2), &
                                      TREE_OUTPUT_DATA_TOTAL(I,3),TREE_OUTPUT_DATA_TOTAL(I,4)
 ENDDO
ENDIF
                                           
 
END SUBROUTINE DUMP_VEG

 

SUBROUTINE UPDATE_MASS(NM)

! Compute the total masses of various gases

USE PHYSICAL_FUNCTIONS, ONLY : GET_MASS_FRACTION_ALL
REAL(EB) :: VC,Y_MF_INT(1:N_Y_ARRAY),YY_GET(1:N_SPECIES)
INTEGER, INTENT(IN) :: NM
INTEGER :: I,J,K
 
IF (.NOT.MASS_FILE) RETURN

IF (EVACUATION_ONLY(NM)) RETURN

MINT(:,NM) = 0._EB
CALL POINT_TO_MESH(NM)
DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) CYCLE
         IF (NM>1) THEN
            IF (INTERPOLATED_MESH(I,J,K)/=0) CYCLE
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         MINT(0,NM) = MINT(0,NM) + VC*RHO(I,J,K)
         IF (N_SPECIES>0) THEN
            YY_GET(:) = YY(I,J,K,:)
            CALL GET_MASS_FRACTION_ALL(YY_GET,Y_MF_INT)            
            MINT(1:N_Y_ARRAY,NM) = MINT(1:N_Y_ARRAY,NM) + RHO(I,J,K)*Y_MF_INT(1:N_Y_ARRAY)*VC
         ENDIF
      ENDDO
   ENDDO
ENDDO
 
MINT_SUM(:,NM) = MINT_SUM(:,NM) + DT*MINT(:,NM)
MINT_TIME_INTERVAL(NM) = MINT_TIME_INTERVAL(NM) + DT

END SUBROUTINE UPDATE_MASS
 
 
SUBROUTINE DUMP_MASS(T)

REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
REAL(EB) :: MINT_TOTAL(0:N_Y_ARRAY)
INTEGER :: NM,N
 
IF (.NOT.MASS_FILE) RETURN

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
MINT_TOTAL(:) = 0._EB
DO NM=1,NMESHES
   IF (MINT_TIME_INTERVAL(NM)>0._EB) MINT_TOTAL(0:N_Y_ARRAY)=MINT_TOTAL(0:N_Y_ARRAY)+MINT_SUM(0:N_Y_ARRAY,NM)/MINT_TIME_INTERVAL(NM)
ENDDO
IF (MIXTURE_FRACTION) THEN
   WRITE(TCFORM,'(A,I4.4,A)') "(",N_Y_ARRAY+1,"(ES15.7E3,','),ES15.7E3)"
   WRITE(LU_MASS,TCFORM) STIME,(MINT_TOTAL(N),N=0,N_Y_ARRAY)
ELSE
   WRITE(TCFORM,'(A,I4.4,A)') "(",N_Y_ARRAY,"(ES15.7E3,','),ES15.7E3)"
   WRITE(LU_MASS,TCFORM) STIME,(MINT_TOTAL(N),N=0,N_Y_ARRAY-1)
ENDIF 
 
END SUBROUTINE DUMP_MASS
 
 

SUBROUTINE DUMP_BNDF(T,NM)

! Dump boundary quantities into CHID_nn.bf file
 
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: ISUM,IG,JG,KG,IOR,NF,IND,I,J,K,I1,I2,J1,J2,K1,K2,IC,IW,N
INTEGER, INTENT(IN) :: NM
 
IF (MESHES(NM)%NPATCH==0) RETURN

IF (EVACUATION_ONLY(NM)) RETURN
 
STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
 
CALL POINT_TO_MESH(NM)
 
FLOOP: DO NF=1,N_BNDF

   BF => BOUNDARY_FILE(NF)
   PY => PROPERTY(BF%PROP_INDEX)
   WRITE(LU_BNDF(NF,NM)) STIME
   IND  = ABS(BF%INDEX)
 
   ! Exterior walls
 
   WLOOP: DO IOR=-3,3
 
      IF (INC(IOR,0)==0 .OR. IOR==0) CYCLE WLOOP
 
      PP  = 0._EB
      PPN = 0._EB
      IBK = 0
 
      SELECT CASE (IOR)
         CASE (1,-1)
            IF (IOR== 1) IG=1    
            IF (IOR==-1) IG=IBAR
            J1 = 1
            J2 = JBAR
            K1 = 1
            K2 = KBAR
            DO K=K1,K2
               DO J=J1,J2
                  IC = CELL_INDEX(IG,J,K)
                  IW = WALL_INDEX(IC,-IOR)
                  PP(J,K) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                  IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY .AND. .NOT.SOLID(CELL_INDEX(IG,J,K))) IBK(J,K)=1
               ENDDO
            ENDDO
            IF (.NOT.BF%CELL_CENTERED) THEN
               DO K=K1-1,K2
                  DO J=J1-1,J2
                     IF (IBK(J,K)==1)     PPN(J,K) = PPN(J,K) + PP(J,K)
                     IF (IBK(J+1,K)==1)   PPN(J,K) = PPN(J,K) + PP(J+1,K)
                     IF (IBK(J,K+1)==1)   PPN(J,K) = PPN(J,K) + PP(J,K+1)
                     IF (IBK(J+1,K+1)==1) PPN(J,K) = PPN(J,K) + PP(J+1,K+1)
                     ISUM = IBK(J,K)+IBK(J,K+1)+IBK(J+1,K)+IBK(J+1,K+1)
                     IF (ISUM>0) THEN
                        PPN(J,K) = PPN(J,K)/REAL(ISUM,EB)
                     ELSE
                        PPN(J,K) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     ENDIF
                  ENDDO
               ENDDO
               WRITE(LU_BNDF(NF,NM)) ((PPN(J,K),J=J1-1,J2),K=K1-1,K2)
            ELSE
               WRITE(LU_BNDF(NF,NM)) ((PP(J,K),J=J1,J2+1),K=K1,K2+1)
            ENDIF

         CASE (2,-2)
            IF (IOR== 2) JG=1    
            IF (IOR==-2) JG=JBAR
            I1 = 1
            I2 = IBAR
            K1 = 1
            K2 = KBAR
            DO K=K1,K2
               DO I=I1,I2
                  IC = CELL_INDEX(I,JG,K)
                  IW = WALL_INDEX(IC,-IOR)
                  PP(I,K) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                  IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY .AND. .NOT.SOLID(CELL_INDEX(I,JG,K))) IBK(I,K)=1
               ENDDO
            ENDDO
            IF (.NOT.BF%CELL_CENTERED) THEN
               DO K=K1-1,K2
                  DO I=I1-1,I2
                     IF (IBK(I,K)==1)     PPN(I,K) = PPN(I,K) + PP(I,K)
                     IF (IBK(I+1,K)==1)   PPN(I,K) = PPN(I,K) + PP(I+1,K)
                     IF (IBK(I,K+1)==1)   PPN(I,K) = PPN(I,K) + PP(I,K+1)
                     IF (IBK(I+1,K+1)==1) PPN(I,K) = PPN(I,K) + PP(I+1,K+1)
                     ISUM = IBK(I,K)+IBK(I,K+1)+IBK(I+1,K)+IBK(I+1,K+1)
                     IF (ISUM>0) THEN
                        PPN(I,K) = PPN(I,K)/REAL(ISUM,EB)
                     ELSE
                        PPN(I,K) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     ENDIF
                  ENDDO
               ENDDO
               WRITE(LU_BNDF(NF,NM)) ((PPN(I,K),I=I1-1,I2),K=K1-1,K2)
            ELSE
               WRITE(LU_BNDF(NF,NM)) ((PP(I,K),I=I1,I2+1),K=K1,K2+1)
            ENDIF
 
         CASE(3,-3)
            IF (IOR== 3) KG=1    
            IF (IOR==-3) KG=KBAR 
            I1 = 1
            I2 = IBAR
            J1 = 1
            J2 = JBAR
            DO J=J1,J2
               DO I=I1,I2
                  IC = CELL_INDEX(I,J,KG)
                  IW = WALL_INDEX(IC,-IOR)
                  PP(I,J) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                  ! Special dump of UL pan test data
                  IF (UL_PAN_DATA .AND. IOR==3 .AND. OUTPUT_QUANTITY(-IND)%NAME=='AMPUA' .AND. MOD(INT(T),100)==0) &
                     WRITE(LU_UL_PAN_DATA,"(F10.4,4(',',F10.4))") T,XW(IW),YW(IW),ZW(IW),PP(I,J)
                  IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY .AND. .NOT.SOLID(CELL_INDEX(I,J,KG))) IBK(I,J)=1
               ENDDO
            ENDDO
            IF (.NOT.BF%CELL_CENTERED) THEN
               DO J=J1-1,J2
                  DO I=I1-1,I2
                     IF (IBK(I,J)==1)     PPN(I,J) = PPN(I,J) + PP(I,J)
                     IF (IBK(I+1,J)==1)   PPN(I,J) = PPN(I,J) + PP(I+1,J)
                     IF (IBK(I,J+1)==1)   PPN(I,J) = PPN(I,J) + PP(I,J+1)
                     IF (IBK(I+1,J+1)==1) PPN(I,J) = PPN(I,J) + PP(I+1,J+1)
                     ISUM = IBK(I,J)+IBK(I,J+1)+IBK(I+1,J)+IBK(I+1,J+1)
                     IF (ISUM>0) THEN
                        PPN(I,J) = PPN(I,J)/REAL(ISUM,EB)
                     ELSE
                        PPN(I,J) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     ENDIF
                  ENDDO
               ENDDO
               WRITE(LU_BNDF(NF,NM)) ((PPN(I,J),I=I1-1,I2),J=J1-1,J2)
            ELSE
               WRITE(LU_BNDF(NF,NM)) ((PP(I,J),I=I1,I2+1),J=J1,J2+1)
            ENDIF

      END SELECT
 
   ENDDO WLOOP
 
! Interior obstructions
 
   BLOOP: DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      I1 = OB%I1+1
      I2 = OB%I2
      J1 = OB%J1+1
      J2 = OB%J2
      K1 = OB%K1+1
      K2 = OB%K2
 
      OLOOP: DO IOR=-3,3
 
         IF (INC(IOR,N)==0 .OR. IOR==0) CYCLE OLOOP
 
         PP = 0._EB
         PPN = 0._EB
         IBK = 0
 
         SELECT CASE (IOR)
            CASE(1,-1)
               IF (IOR== 1) I=I2+1
               IF (IOR==-1) I=I1-1
               DO K=K1,K2
                  DO J=J1,J2
                     IC = CELL_INDEX(I,J,K)
                     IW = WALL_INDEX(IC,-IOR)
                     PP(J,K) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY) IBK(J,K)=1
                  ENDDO
               ENDDO
               IF (.NOT.BF%CELL_CENTERED) THEN
                  DO K=K1-1,K2
                     DO J=J1-1,J2
                        IF (IBK(J,K)==1)     PPN(J,K) = PPN(J,K) + PP(J,K)
                        IF (IBK(J+1,K)==1)   PPN(J,K) = PPN(J,K) + PP(J+1,K)
                        IF (IBK(J,K+1)==1)   PPN(J,K) = PPN(J,K) + PP(J,K+1)
                        IF (IBK(J+1,K+1)==1) PPN(J,K) = PPN(J,K) + PP(J+1,K+1)
                        ISUM = IBK(J,K)+IBK(J,K+1)+IBK(J+1,K)+IBK(J+1,K+1)
                        IF (ISUM>0) THEN
                           PPN(J,K) = PPN(J,K)/REAL(ISUM,EB)
                        ELSE
                           PPN(J,K) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                        ENDIF
                     ENDDO
                  ENDDO
                  WRITE(LU_BNDF(NF,NM)) ((PPN(J,K),J=J1-1,J2),K=K1-1,K2)
               ELSE
                  WRITE(LU_BNDF(NF,NM)) ((PP(J,K),J=J1,J2+1),K=K1,K2+1)
               ENDIF
 
            CASE(2,-2)
               IF (IOR== 2) J=J2+1
               IF (IOR==-2) J=J1-1
               DO K=K1,K2
                  DO I=I1,I2
                     IC = CELL_INDEX(I,J,K)
                     IW = WALL_INDEX(IC,-IOR)
                     PP(I,K) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY) IBK(I,K)=1
                  ENDDO
               ENDDO
               IF (.NOT.BF%CELL_CENTERED) THEN
                  DO K=K1-1,K2
                     DO I=I1-1,I2
                        IF (IBK(I,K)==1)     PPN(I,K) = PPN(I,K) + PP(I,K)
                        IF (IBK(I+1,K)==1)   PPN(I,K) = PPN(I,K) + PP(I+1,K)
                        IF (IBK(I,K+1)==1)   PPN(I,K) = PPN(I,K) + PP(I,K+1)
                        IF (IBK(I+1,K+1)==1) PPN(I,K) = PPN(I,K) + PP(I+1,K+1)
                        ISUM = IBK(I,K)+IBK(I,K+1)+IBK(I+1,K)+IBK(I+1,K+1)
                        IF (ISUM>0) THEN
                           PPN(I,K) = PPN(I,K)/REAL(ISUM,EB)
                        ELSE
                           PPN(I,K) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                        ENDIF
                     ENDDO
                  ENDDO
                  WRITE(LU_BNDF(NF,NM)) ((PPN(I,K),I=I1-1,I2),K=K1-1,K2)
               ELSE
                  WRITE(LU_BNDF(NF,NM)) ((PP(I,K),I=I1,I2+1),K=K1,K2+1)
               ENDIF
       
            CASE(3,-3)
               IF (IOR== 3) K=K2+1
               IF (IOR==-3) K=K1-1
               DO J=J1,J2
                  DO I=I1,I2
                     IC = CELL_INDEX(I,J,K)
                     IW = WALL_INDEX(IC,-IOR)
                     PP(I,J) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                     ! Special dump of UL pan test data
                     IF (UL_PAN_DATA .AND. IOR==3 .AND. OUTPUT_QUANTITY(-IND)%NAME=='AMPUA' .AND. MOD(INT(T),100)==0) &
                        WRITE(LU_UL_PAN_DATA,"(F10.4,4(',',F10.4))") T,XW(IW),YW(IW),ZW(IW),PP(I,J)
                     IF (BOUNDARY_TYPE(IW)/=NULL_BOUNDARY) IBK(I,J)=1
                  ENDDO
               ENDDO
               IF (.NOT.BF%CELL_CENTERED) THEN
                  DO J=J1-1,J2
                     DO I=I1-1,I2
                        IF (IBK(I,J)==1)     PPN(I,J) = PPN(I,J) + PP(I,J)
                        IF (IBK(I+1,J)==1)   PPN(I,J) = PPN(I,J) + PP(I+1,J)
                        IF (IBK(I,J+1)==1)   PPN(I,J) = PPN(I,J) + PP(I,J+1)
                        IF (IBK(I+1,J+1)==1) PPN(I,J) = PPN(I,J) + PP(I+1,J+1)
                        ISUM = IBK(I,J)+IBK(I,J+1)+IBK(I+1,J)+IBK(I+1,J+1)
                        IF (ISUM>0) THEN
                           PPN(I,J) = PPN(I,J)/REAL(ISUM,EB)
                        ELSE
                           PPN(I,J) = SOLID_PHASE_OUTPUT(NM,0,IND,BF%SPEC_INDEX,BF%PART_INDEX)
                        ENDIF
                     ENDDO
                  ENDDO
                  WRITE(LU_BNDF(NF,NM)) ((PPN(I,J),I=I1-1,I2),J=J1-1,J2)
               ELSE
                  WRITE(LU_BNDF(NF,NM)) ((PP(I,J),I=I1,I2+1),J=J1,J2+1)
               ENDIF

         END SELECT
 
      ENDDO OLOOP
   ENDDO BLOOP
ENDDO FLOOP

END SUBROUTINE DUMP_BNDF
 
 
SUBROUTINE DUMP_BNDF_TO_SLCF(T,NM)

! Project boundary surface onto a plane and output as a slice file to CHID_nn_bf.sf file
 
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: ISUM,KG,IOR,NF,IND,I,J,K,I1,I2,J1,J2,K1,K2,IC,IW,N
INTEGER, INTENT(IN) :: NM
 
IF (MESHES(NM)%NPATCH==0) RETURN

IF (EVACUATION_ONLY(NM)) RETURN
 
STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
 
CALL POINT_TO_MESH(NM)
 
FLOOP: DO NF=1,N_BNDF

   BF => BOUNDARY_FILE(NF)
   PY => PROPERTY(BF%PROP_INDEX)
   WRITE(LU_BNDF_SLCF(NF,NM)) STIME
   IND  = ABS(BF%INDEX)
 
   ! Exterior walls
 
   IOR=3
 
   PP  = 100._FB
   PPN = 100._FB

   IF (INC(IOR,0).NE.0) THEN
      KG=1 
      DO J=1,JBAR
         DO I=1,IBAR
            IC = CELL_INDEX(I,J,KG)
            IW = WALL_INDEX(IC,-IOR)
            PP(I,J) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
         ENDDO
      ENDDO
   ENDIF

 
! Interior obstructions
 
   BLOOP: DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      I1 = OB%I1+1
      I2 = OB%I2
      J1 = OB%J1+1
      J2 = OB%J2
      K1 = OB%K1+1
      K2 = OB%K2
 
      IOR=3
 
      IF (INC(IOR,N).NE.0) THEN
 
         K=K2+1
         DO J=J1,J2
            DO I=I1,I2
               IC = CELL_INDEX(I,J,K)
               IW = WALL_INDEX(IC,-IOR)
               PP(I,J) = SOLID_PHASE_OUTPUT(NM,IW,IND,BF%SPEC_INDEX,BF%PART_INDEX)
            ENDDO
         ENDDO
      ENDIF
   ENDDO BLOOP

   IF (.NOT.BF%CELL_CENTERED) THEN
      PPN=0.0_FB
      DO J=0,JBAR
         DO I=0,IBAR
            ISUM=0
            IF(I.NE.0.AND.J.NE.0)THEN
              PPN(I,J) = PPN(I,J) + PP(I,J)
              ISUM = ISUM + 1
            ENDIF
            IF(I.NE.IBAR.AND.J.NE.0)THEN
              PPN(I,J) = PPN(I,J) + PP(I+1,J)
              ISUM = ISUM + 1
            ENDIF
            IF(I.NE.0.AND.J.NE.JBAR)THEN
              PPN(I,J) = PPN(I,J) + PP(I,J+1)
              ISUM = ISUM + 1
            ENDIF
            IF(I.NE.IBAR.AND.J.NE.JBAR)THEN
              PPN(I,J) = PPN(I,J) + PP(I+1,J+1)
              ISUM = ISUM + 1
            ENDIF
            IF(ISUM>0)THEN
              PPN(I,J)=PPN(I,J)/ISUM
            ELSE
              PPN(I,J)=PP(I,J)
            ENDIF
         ENDDO
      ENDDO
      WRITE(LU_BNDF_SLCF(NF,NM)) ((PPN(I,J),I=0,IBAR),J=0,JBAR)
   ELSE
      WRITE(LU_BNDF_SLCF(NF,NM)) ((PP(I,J),I=1,IBAR+1),J=1,JBAR+1)
   ENDIF
ENDDO FLOOP

END SUBROUTINE DUMP_BNDF_TO_SLCF

SUBROUTINE FLUSH_GLOBAL_BUFFERS

INTEGER :: N
 
CLOSE(LU_SMV)
OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
CLOSE(LU_OUTPUT)
OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')

DO N=1,N_DEVC_FILES
   CLOSE(LU_DEVC(N))
   OPEN(LU_DEVC(N),FILE=FN_DEVC(N),FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
ENDDO

DO N=1,N_CTRL_FILES
   CLOSE(LU_CTRL(N))
   OPEN(LU_CTRL(N),FILE=FN_CTRL(N),FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
ENDDO

DO N=1,N_TREES_OUT
   CLOSE(LU_VEG_OUT(N))
   OPEN(LU_VEG_OUT(N),FILE=FN_VEG_OUT(N),FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
ENDDO

CLOSE(LU_HRR)
OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')

IF (MASS_FILE) THEN
   CLOSE(LU_MASS)
   OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   CLOSE(LU_VELOCITY_ERROR)
   OPEN(LU_VELOCITY_ERROR,FILE=FN_VELOCITY_ERROR,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ENDIF

END SUBROUTINE FLUSH_GLOBAL_BUFFERS
 
SUBROUTINE FLUSH_EVACUATION_BUFFERS

IF (ANY(EVACUATION_GRID)) THEN
   CLOSE(LU_EVACCSV)
   OPEN (LU_EVACCSV,FILE=FN_EVACCSV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   CLOSE(LU_EVACOUT)
   OPEN (LU_EVACOUT,FILE=FN_EVACOUT,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   IF (BTEST(I_EVAC,0)) THEN
      CLOSE(LU_EVACEFF)
      OPEN (LU_EVACEFF,FILE=FN_EVACEFF,FORM='UNFORMATTED', STATUS='OLD',POSITION='APPEND')
   ENDIF
   IF (BTEST(I_EVAC,1)) THEN
      CLOSE(LU_EVACFED)
      OPEN(LU_EVACFED,FILE=FN_EVACFED,FORM='UNFORMATTED', STATUS='OLD',POSITION='APPEND')
   ENDIF
ENDIF

END SUBROUTINE FLUSH_EVACUATION_BUFFERS

SUBROUTINE FLUSH_LOCAL_BUFFERS(NM)

INTEGER, INTENT(IN) :: NM
INTEGER :: N
LOGICAL :: EX

IF ( (DROPLET_FILE.AND..NOT.EVACUATION_ONLY(NM)) .OR. (EVACUATION_ONLY(NM).AND.EVACUATION_GRID(NM)) ) THEN
   CLOSE(LU_PART(NM))
   OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
ENDIF

DO N=1,MESHES(NM)%N_SLCF
   CLOSE(LU_SLCF(N,NM))
   OPEN(LU_SLCF(N,NM),FILE=FN_SLCF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
ENDDO

DO N=1,N_BNDF
   INQUIRE(FILE=FN_BNDF(N,NM),EXIST=EX)
   IF (EX) THEN
      CLOSE(LU_BNDF(N,NM))
      OPEN(LU_BNDF(N,NM),FILE=FN_BNDF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
   ENDIF
ENDDO

IF(TERRAIN_CASE)THEN
   DO N=1,N_BNDF
      INQUIRE(FILE=FN_BNDF_SLCF(N,NM),EXIST=EX)
      IF (EX) THEN
         CLOSE(LU_BNDF_SLCF(N,NM))
         OPEN(LU_BNDF_SLCF(N,NM),FILE=FN_BNDF_SLCF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      ENDIF
   ENDDO
ENDIF

DO N=1,N_PROF
   IF (PROFILE(N)%MESH==NM) THEN
      CLOSE(LU_PROF(N))
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   ENDIF
ENDDO

END SUBROUTINE FLUSH_LOCAL_BUFFERS
 
 
SUBROUTINE TIMINGS

! Print out detector activation times and subroutine CPU usage
 
USE COMP_FUNCTIONS, ONLY: WALL_CLOCK_TIME
REAL(EB) :: TPCNT(N_TIMERS_DIM)
CHARACTER(6) :: NAME(N_TIMERS_DIM)
INTEGER :: NM,I,N

! Print out detector times
 
IF (N_DEVC > 0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' DEVICE Activation Times'
   DO N=1,N_DEVC
      DV => DEVICE(N)
     IF (DV%T_CHANGE < 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,F8.1,A)') N,DV%ID,DV%T_CHANGE,' s'
!     IF (DV%T_CHANGE > 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,A)')      N,DV%ID,'No Activation'
   ENDDO
ENDIF

! Printout subroutine timings
 
NAME     = 'null'
NAME(1)  = 'MAIN'
NAME(2)  = 'DIVG'
NAME(3)  = 'MASS'
NAME(4)  = 'VELO'
NAME(5)  = 'PRES'
NAME(6)  = 'WALL'
NAME(7)  = 'DUMP'
NAME(8)  = 'PART'
NAME(9)  = 'RADI'
NAME(10) = 'FIRE'
NAME(11) = 'COMM'
NAME(12) = 'EVAC'
NAME(13) = ' FOR'
NAME(14) = ' P2P'
NAME(15) = ' MOV'
! Additional timings
NAME(16) = 'MEX1'
NAME(17) = 'MEX2'
NAME(18) = 'MEX3'
NAME(19) = 'MEX4'
NAME(20) = 'MEX5'
NAME(21) = 'MEX6'
 
DO NM=1,NMESHES
   DO I=1,N_TIMERS_DIM
      TPCNT(I) = 100._EB*TUSED(I,NM)/TUSED(1,NM)
   ENDDO
   IF (EVACUATION_GRID(NM)) THEN
      WRITE(LU_OUTPUT,443) NM,(NAME(I),TUSED(I,NM),TPCNT(I),I=1,N_TIMERS_EVAC)
      WRITE(LU_OUTPUT,'(7X,A6,2F11.2)') 'SubTot',SUM(TUSED(2:N_TIMERS_EVAC-3,NM)),SUM(TPCNT(2:N_TIMERS_EVAC-3))
   ELSE
      WRITE(LU_OUTPUT,443) NM,(NAME(I),TUSED(I,NM),TPCNT(I),I=1,N_TIMERS_FDS)
      WRITE(LU_OUTPUT,'(7X,A6,2F11.2)') 'SubTot',SUM(TUSED(2:N_TIMERS_FDS,NM)),SUM(TPCNT(2:N_TIMERS_FDS))
   ENDIF 
   !WRITE(LU_OUTPUT,443) NM,(NAME(I),TUSED(I,NM),TPCNT(I),I=16,N_TIMERS_DIM)
ENDDO
 
443 FORMAT(//' CPU Time Usage, Mesh ',I3// &
         '                 CPU (s)        %  '/ &
         '       ----------------------------'/ &
         (7X,A6,2F11.2))
 
WALL_CLOCK_END = WALL_CLOCK_TIME()
WRITE(LU_OUTPUT,'(//A,F12.3)') ' Time Stepping Wall Clock Time (s): ',WALL_CLOCK_END-WALL_CLOCK_START_ITERATIONS
WRITE(LU_OUTPUT,'(  A,F12.3)') ' Total Elapsed Wall Clock Time (s): ',WALL_CLOCK_END-WALL_CLOCK_START

END SUBROUTINE TIMINGS

SUBROUTINE GET_LAYER_HEIGHT(II,JJ,K_LO,K_HI,ZINT,TMPUP,TMPLOW)

! Compute the layer height, average upper and lower layer temperatures, and upper layer absorption coefficient

INTEGER, INTENT(IN) :: II,JJ,K_LO,K_HI
INTEGER :: K
REAL(EB) :: I_1,I_2,Z_HI,Z_LO
REAL(FB), INTENT(OUT) :: TMPLOW,TMPUP,ZINT

Z_LO = Z(K_LO-1)
Z_HI = Z(K_HI)

I_1 = 0._EB
I_2 = 0._EB
DO K=K_LO,K_HI
   I_1 = I_1 + DZ(K)*TMP(II,JJ,K)
   I_2 = I_2 + DZ(K)/TMP(II,JJ,K)
ENDDO

TMPLOW = TMP(II,JJ,K_LO)
ZINT   = (I_1+I_2*TMPLOW**2-2._EB*TMPLOW*(Z_HI-Z_LO))

IF (ZINT==0._EB) THEN
   ZINT = Z_HI-Z_LO
ELSE
   ZINT = TMPLOW*(I_1*I_2-(Z_HI-Z_LO)**2)/ZINT
ENDIF

I_1 = 0._EB
DO K=K_LO,K_HI
   IF (Z(K-1)-Z_LO>=ZINT) THEN
      I_1 = I_1 + TMP(II,JJ,K)  *DZ(K)
   ELSEIF (Z(K)-Z_LO>ZINT) THEN
      I_1 = I_1 + TMP(II,JJ,K)  *(Z(K)-Z_LO-ZINT)
   ELSE
   ENDIF
ENDDO

IF (I_1==0._EB) THEN
   TMPUP = TMPLOW
ELSE
   TMPUP = I_1/(Z_HI-Z_LO-ZINT)
ENDIF
IF (ABS(TMPLOW-TMPUP)<5. .OR. ZINT<=0._EB) THEN
   TMPUP = TMPLOW
   ZINT  = Z_HI-Z_LO
ENDIF

END SUBROUTINE GET_LAYER_HEIGHT

SUBROUTINE GET_REV_dump(MODULE_REV,MODULE_DATE)
INTEGER,INTENT(INOUT) :: MODULE_REV
CHARACTER(255),INTENT(INOUT) :: MODULE_DATE

WRITE(MODULE_DATE,'(A)') dumprev(INDEX(dumprev,':')+1:LEN_TRIM(dumprev)-2)
READ (MODULE_DATE,'(I5)') MODULE_REV
WRITE(MODULE_DATE,'(A)') dumpdate

END SUBROUTINE GET_REV_dump

END MODULE DUMP
